home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 May / CMCD0504.ISO / Software / Freeware / Programare / dspack / DSPACK231.exe / {app} / src / DSPack / BaseClass.pas next >
Encoding:
Pascal/Delphi Source File  |  2003-04-30  |  197.9 KB  |  6,189 lines
  1.     (*********************************************************************
  2.      *  DSPack 2.3                                                       *
  3.      *  DirectShow BaseClass                                             * 
  4.      *                                                                   * 
  5.      * home page : http://www.progdigy.com                               * 
  6.      * email     : hgourvest@progdigy.com                                * 
  7.      *                                                                   * 
  8.      * date      : 21-02-2003                                            * 
  9.      *                                                                   * 
  10.      * The contents of this file are used with permission, subject to    * 
  11.      * the Mozilla Public License Version 1.1 (the "License"); you may   * 
  12.      * not use this file except in compliance with the License. You may  * 
  13.      * obtain a copy of the License at                                   * 
  14.      * http://www.mozilla.org/MPL/MPL-1.1.html                           * 
  15.      *                                                                   * 
  16.      * Software distributed under the License is distributed on an       * 
  17.      * "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or    * 
  18.      * implied. See the License for the specific language governing      * 
  19.      * rights and limitations under the License.                         * 
  20.      *                                                                   * 
  21.      *********************************************************************)
  22.  
  23. {.$DEFINE DEBUG} // Debug Log
  24. {.$DEFINE TRACE} // Trace Criteral Section (DEBUG must be ON)
  25.  
  26. unit BaseClass;
  27.  
  28. {$IFDEF VER150}
  29.   {$WARN UNSAFE_CODE OFF}
  30.   {$WARN UNSAFE_TYPE OFF}
  31.   {$WARN UNSAFE_CAST OFF}
  32. {$ENDIF}
  33.  
  34. interface
  35. uses Windows, SysUtils, Classes, Math, ActiveX, Forms, Messages, Controls,
  36.   DirectShow9, DSUtil, dialogs, ComObj;
  37.  
  38. const
  39.   OATRUE  = -1;
  40.   OAFALSE = 0;
  41.  
  42. type
  43.   TBCCritSec = class
  44.   private
  45.     FCritSec : TRTLCriticalSection;
  46.   {$IFDEF DEBUG}
  47.     FcurrentOwner: Longword;
  48.     FlockCount   : Longword;
  49.     FTrace       : boolean; // Trace this one
  50.   {$ENDIF}
  51.   public
  52.     constructor Create;
  53.     destructor Destroy; override;
  54.     procedure Lock;
  55.     procedure UnLock;
  56.     function CritCheckIn: boolean;
  57.     function CritCheckOut: boolean;
  58.   {$IFDEF DEBUG}
  59.     property Trace: boolean read FTrace write FTrace;
  60.   {$ENDIF}
  61.   end;
  62.  
  63.   TBCBaseObject = class(TObJect)
  64.   private
  65.     FName: string;
  66.   public
  67.     constructor Create(Name: string);
  68.     class function NewInstance: TObject; override;
  69.     procedure FreeInstance; override;
  70.     class function ObjectsActive: integer;
  71.   end;
  72.  
  73.   TBCClassFactory = Class;
  74.  
  75.   TBCUnknown = class(TBCBaseObject, IUnKnown)
  76.   private
  77.     FRefCount: integer;
  78.     FOwner   : Pointer;
  79.   protected
  80.     function IUnknown.QueryInterface = NonDelegatingQueryInterface;
  81.     function IUnknown._AddRef = NonDelegatingAddRef;
  82.     function IUnknown._Release = NonDelegatingRelease;
  83.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  84.     function _AddRef: Integer; stdcall;
  85.     function _Release: Integer; stdcall;
  86.   public
  87.     constructor Create(name: string; Unk: IUnknown);
  88.     constructor CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown); virtual;
  89.     function NonDelegatingQueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  90.     function NonDelegatingAddRef: Integer; virtual; stdcall;
  91.     function NonDelegatingRelease: Integer; virtual; stdcall;
  92.     function GetOwner: IUnKnown;
  93.   end;
  94.  
  95.   TBCUnknownClass = Class of TBCUnknown;
  96.  
  97.   TFormPropertyPage = class;
  98.   TFormPropertyPageClass = class of TFormPropertyPage;
  99.  
  100.   TBCBaseFilter = class;
  101.   TBCBaseFilterClass = class of TBCBaseFilter;
  102.  
  103.   TBCClassFactory = class(TObject, IUnKnown, IClassFactory)
  104.   private
  105.    FNext     : TBCClassFactory;
  106.    FComClass : TBCUnknownClass;
  107.    FPropClass: TFormPropertyPageClass;
  108.    FName     : String;
  109.    FClassID  : TGUID;
  110.    FCategory : TGUID;
  111.    FMerit    : LongWord;
  112.    FPinCount : Cardinal;
  113.    FPins     : PRegFilterPins;
  114.    function RegisterFilter(FilterMapper: IFilterMapper; Register: Boolean): boolean; overload;
  115.    function RegisterFilter(FilterMapper: IFilterMapper2; Register: Boolean): boolean; overload;
  116.    procedure UpdateRegistry(Register: Boolean); overload;
  117.   protected
  118.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  119.     function _AddRef: Integer; stdcall;
  120.     function _Release: Integer; stdcall;
  121.     function CreateInstance(const UnkOuter: IUnknown; const IID: TGUID;
  122.       out Obj): HResult; stdcall;
  123.     function LockServer(fLock: BOOL): HResult; stdcall;
  124.   public
  125.     constructor CreateFilter(ComClass: TBCUnknownClass; Name: string;
  126.       const ClassID: TGUID; const Category: TGUID; Merit: LongWord;
  127.       PinCount: Cardinal; Pins: PRegFilterPins);
  128.     constructor CreatePropertyPage(ComClass: TFormPropertyPageClass; const ClassID: TGUID);
  129.     property Name: String read FName;
  130.     property ClassID: TGUID read FClassID;
  131.   end;
  132.  
  133.  
  134.  
  135.   TBCFilterTemplate = class
  136.   private
  137.     FFactoryList : TBCClassFactory;
  138.     procedure AddObjectFactory(Factory: TBCClassFactory);
  139.   public
  140.     constructor Create;
  141.     destructor Destroy; override;
  142.     function RegisterServer(Register: Boolean): boolean;
  143.     function GetFactoryFromClassID(const CLSID: TGUID): TBCClassFactory;
  144.   end;
  145.  
  146.  
  147.   TBCMediaType = object
  148.     MediaType: PAMMediaType;
  149.     function Equal(mt: TBCMediaType): boolean; overload;
  150.     function Equal(mt: PAMMediaType): boolean; overload;
  151.     function MatchesPartial(Partial: PAMMediaType): boolean;
  152.     function IsPartiallySpecified: boolean;
  153.     function IsValid: boolean;
  154.     procedure InitMediaType;
  155.     function FormatLength: Cardinal;
  156.   end;
  157.  
  158.  
  159.   TBCBasePin = class;
  160.  
  161.   TBCBaseFilter = class(TBCUnknown, IBaseFilter, IAMovieSetup)
  162.   protected
  163.     FState : TFilterState;     // current state: running, paused
  164.     FClock : IReferenceClock;   // this graph's ref clock
  165.     FStart : TReferenceTime;   // offset from stream time to reference time
  166.     FCLSID : TGUID;             // This filters clsid used for serialization
  167.     FLock  : TBCCritSec;          // Object we use for locking
  168.  
  169.     FFilterName : WideString;   // Full filter name
  170.     FGRaph : IFilterGraph;      // Graph we belong to
  171.     FSink  : IMediaEventSink;   // Called with notify events
  172.     FPinVersion: Integer;       // Current pin version
  173.   public
  174.     constructor Create(Name: string;           // Object description
  175.                        Unk : IUnKnown;         // IUnknown of delegating object
  176.                        Lock: TBCCritSec;       // Object who maintains lock
  177.                        const clsid: TGUID      // The clsid to be used to serialize this filter
  178.                        ); overload;
  179.  
  180.     constructor Create(Name: string;           // Object description
  181.                        Unk : IUnKnown;         // IUnknown of delegating object
  182.                        Lock: TBCCritSec;       // Object who maintains lock
  183.                        const clsid: TGUID;     // The clsid to be used to serialize this filter
  184.                        out hr: HRESULT         // General OLE return code
  185.                        ); overload;
  186.     constructor CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown); override;
  187.     destructor destroy; override;
  188.     // --- IPersist method ---
  189.     function GetClassID(out classID: TCLSID): HResult; stdcall;
  190.     // --- IMediaFilter methods ---
  191.     // override Stop and Pause so we can activate the pins.
  192.     // Note that Run will call Pause first if activation needed.
  193.     // Override these if you want to activate your filter rather than
  194.     // your pins.
  195.     function Stop: HRESULT; virtual; stdcall;
  196.     function Pause: HRESULT; virtual; stdcall;
  197.     // the start parameter is the difference to be added to the
  198.     // sample's stream time to get the reference time for
  199.     // its presentation
  200.     function Run(tStart: TReferenceTime): HRESULT; virtual; stdcall;
  201.     function GetState(dwMilliSecsTimeout: DWORD; out State: TFilterState): HRESULT; virtual; stdcall;
  202.     function SetSyncSource(pClock: IReferenceClock): HRESULT; stdcall;
  203.     function GetSyncSource(out pClock: IReferenceClock): HRESULT; stdcall;
  204.     // --- helper methods ---
  205.     // return the current stream time - ie find out what
  206.     // stream time should be appearing now
  207.     function StreamTime(out rtStream: TReferenceTime): HRESULT; virtual;
  208.     // Is the filter currently active?
  209.     function IsActive: boolean;
  210.     // Is this filter stopped (without locking)
  211.     function IsStopped: boolean;
  212.     // --- IBaseFilter methods ---
  213.     // pin enumerator
  214.     function EnumPins(out ppEnum: IEnumPins): HRESULT; stdcall;
  215.     // default behaviour of FindPin assumes pin ids are their names
  216.     function FindPin(Id: PWideChar; out ppPin: IPin): HRESULT; virtual; stdcall;
  217.     function QueryFilterInfo(out pInfo: TFilterInfo): HRESULT; stdcall;
  218.     function JoinFilterGraph(pGraph: IFilterGraph; pName: PWideChar): HRESULT; stdcall;
  219.     // return a Vendor information string. Optional - may return E_NOTIMPL.
  220.     // memory returned should be freed using CoTaskMemFree
  221.     // default implementation returns E_NOTIMPL
  222.     function QueryVendorInfo(out pVendorInfo: PWideChar): HRESULT; stdcall;
  223.     // --- helper methods ---
  224.     // send an event notification to the filter graph if we know about it.
  225.     // returns S_OK if delivered, S_FALSE if the filter graph does not sink
  226.     // events, or an error otherwise.
  227.     function NotifyEvent(EventCode, EventParam1, EventParam2: LongInt): HRESULT;
  228.     // return the filter graph we belong to
  229.     function GetFilterGraph: IFilterGraph;
  230.     // Request reconnect
  231.     // pPin is the pin to reconnect
  232.     // pmt is the type to reconnect with - can be NULL
  233.     // Calls ReconnectEx on the filter graph
  234.     function ReconnectPin(Pin: IPin; pmt: PAMMediaType): HRESULT;
  235.     // find out the current pin version (used by enumerators)
  236.     function GetPinVersion: LongInt; virtual;
  237.     procedure IncrementPinVersion;
  238.     // you need to supply these to access the pins from the enumerator
  239.     // and for default Stop and Pause/Run activation.
  240.     function GetPinCount: integer; virtual; abstract;
  241.     function GetPin(n: Integer): TBCBasePin; virtual; abstract;
  242.     // --- IAMovieSetup methods ---
  243.     function Register: HRESULT; stdcall;
  244.     function Unregister: HRESULT; stdcall;
  245.  
  246.     property State: TFilterState read FState;
  247.     property GRaph : IFilterGraph read FGRaph;
  248.   end;
  249.  
  250.  { NOTE The implementation of this class calls the CUnknown constructor with
  251.    a NULL outer unknown pointer. This has the effect of making us a self
  252.    contained class, ie any QueryInterface, AddRef or Release calls will be
  253.    routed to the class's NonDelegatingUnknown methods. You will typically
  254.    find that the classes that do this then override one or more of these
  255.    virtual functions to provide more specialised behaviour. A good example
  256.    of this is where a class wants to keep the QueryInterface internal but
  257.    still wants its lifetime controlled by the external object }
  258.  
  259.   TBCBasePin = class(TBCUnknown, IPin, IQualityControl)
  260.   private
  261.     FPinName: WideString;
  262.     FConnected             : IPin;             // Pin we have connected to
  263.     Fdir                   : TPinDirection;   // Direction of this pin
  264.     FLock                  : TBCCritSec;       // Object we use for locking
  265.     FRunTimeError          : boolean;          // Run time error generated
  266.     FCanReconnectWhenActive: boolean;          // OK to reconnect when active
  267.     FTryMyTypesFirst       : boolean;          // When connecting enumerate
  268.                                                // this pin's types first
  269.     FFilter                : TBCBaseFilter;    // Filter we were created by
  270.     FQSink                 : IQualityControl;  // Target for Quality messages
  271.     FTypeVersion           : LongInt;          // Holds current type version
  272.     Fmt                    : TAMMediaType;   // Media type of connection
  273.  
  274.     FStart                 : TReferenceTime;  // time from NewSegment call
  275.     FStop                  : TReferenceTime;  // time from NewSegment
  276.     FRate                  : double;           // rate from NewSegment
  277.  
  278.     FRef                   : LongInt;
  279.     function GetCurrentMediaType: TBCMediaType;
  280.     function GetAMMediaType: PAMMediaType;
  281.   protected
  282.     procedure DisplayPinInfo(ReceivePin: IPin);
  283.     procedure DisplayTypeInfo(Pin: IPin; pmt: PAMMediaType);
  284.  
  285.     // used to agree a media type for a pin connection
  286.     // given a specific media type, attempt a connection (includes
  287.     // checking that the type is acceptable to this pin)
  288.     function AttemptConnection(
  289.        ReceivePin: IPin;      // connect to this pin
  290.        pmt       : PAMMediaType // using this type
  291.        ): HRESULT;
  292.     // try all the media types in this enumerator - for each that
  293.     // we accept, try to connect using ReceiveConnection.
  294.     function TryMediaTypes(
  295.                ReceivePin: IPin;           // connect to this pin
  296.                pmt       : PAMMediaType;     // proposed type from Connect
  297.                Enum      : IEnumMediaTypes // try this enumerator
  298.                ): HRESULT;
  299.  
  300.     // establish a connection with a suitable mediatype. Needs to
  301.     // propose a media type if the pmt pointer is null or partially
  302.     // specified - use TryMediaTypes on both our and then the other pin's
  303.     // enumerator until we find one that works.
  304.     function AgreeMediaType(
  305.                ReceivePin: IPin;      // connect to this pin
  306.                pmt       : PAMMediaType // proposed type from Connect
  307.                ): HRESULT;
  308.     function DisconnectInternal: HRESULT; stdcall;
  309.   public
  310.     function NonDelegatingAddRef: Integer; override; stdcall;
  311.     function NonDelegatingRelease: Integer; override; stdcall;
  312.     constructor Create(
  313.                   ObjectName: string;           // Object description
  314.                   Filter    : TBCBaseFilter;      // Owning filter who knows about pins
  315.                   Lock      : TBCCritSec;         // Object who implements the lock
  316.                   out hr    : HRESULT;          // General OLE return code
  317.                   Name      : WideString;       // Pin name for us
  318.                   dir       : TPinDirection);  // Either PINDIR_INPUT or PINDIR_OUTPUT
  319.     destructor destroy; override;
  320.     // --- IPin methods ---
  321.     // take lead role in establishing a connection. Media type pointer
  322.     // may be null, or may point to partially-specified mediatype
  323.     // (subtype or format type may be GUID_NULL).
  324.     function Connect(pReceivePin: IPin; const pmt: PAMMediaType): HRESULT; stdcall;
  325.     // (passive) accept a connection from another pin
  326.     function ReceiveConnection(pConnector: IPin; const pmt: TAMMediaType): HRESULT; stdcall;
  327.     function Disconnect: HRESULT; stdcall;
  328.     function ConnectedTo(out pPin: IPin): HRESULT; stdcall;
  329.     function ConnectionMediaType(out pmt: TAMMediaType): HRESULT; stdcall;
  330.     function QueryPinInfo(out pInfo: TPinInfo): HRESULT; stdcall;
  331.     function QueryDirection(out pPinDir: TPinDirection): HRESULT; stdcall;
  332.     function QueryId(out Id: PWideChar): HRESULT; virtual; stdcall;
  333.     // does the pin support this media type
  334.     function QueryAccept(const pmt: TAMMediaType): HRESULT; stdcall;
  335.     // return an enumerator for this pins preferred media types
  336.     function EnumMediaTypes(out ppEnum: IEnumMediaTypes): HRESULT; virtual; stdcall;
  337.     // return an array of IPin* - the pins that this pin internally connects to
  338.     // All pins put in the array must be AddReffed (but no others)
  339.     // Errors: "Can't say" - FAIL, not enough slots - return S_FALSE
  340.     // Default: return E_NOTIMPL
  341.     // The filter graph will interpret NOT_IMPL as any input pin connects to
  342.     // all visible output pins and vice versa.
  343.     // apPin can be NULL if nPin==0 (not otherwise).
  344.     function QueryInternalConnections(out apPin: IPin; var nPin: ULONG): HRESULT; virtual; stdcall;
  345.     // Called when no more data will be sent
  346.     function EndOfStream: HRESULT; virtual; stdcall;
  347.     function BeginFlush: HRESULT; virtual; stdcall; abstract;
  348.     function EndFlush: HRESULT; virtual; stdcall; abstract;
  349.     // Begin/EndFlush still PURE
  350.  
  351.     // NewSegment notifies of the start/stop/rate applying to the data
  352.     // about to be received. Default implementation records data and
  353.     // returns S_OK.
  354.     // Override this to pass downstream.
  355.     function NewSegment(tStart, tStop: TReferenceTime; dRate: double): HRESULT; virtual; stdcall;
  356.     // --- IQualityControl methods ---
  357.     function Notify(pSelf: IBaseFilter; q: TQuality): HRESULT; virtual; stdcall;
  358.     function SetSink(piqc: IQualityControl): HRESULT; virtual; stdcall;
  359.     // --- helper methods ---
  360.  
  361.     // Returns true if the pin is connected. false otherwise.
  362.     function IsConnected: boolean;
  363.     // Return the pin this is connected to (if any)
  364.     property GetConnected: IPin read FConnected;
  365.     // Check if our filter is currently stopped
  366.     function IsStopped: boolean;
  367.     // find out the current type version (used by enumerators)
  368.     function GetMediaTypeVersion: longint; virtual;
  369.     procedure IncrementTypeVersion;
  370.     // switch the pin to active (paused or running) mode
  371.     // not an error to call this if already active
  372.     function Active: HRESULT; virtual;
  373.     // switch the pin to inactive state - may already be inactive
  374.     function Inactive: HRESULT; virtual;
  375.     // Notify of Run() from filter
  376.     function Run(Start: TReferenceTime): HRESULT; virtual;
  377.     // check if the pin can support this specific proposed type and format
  378.     function CheckMediaType(mt: PAMMediaType): HRESULT; virtual; abstract;
  379.     // set the connection to use this format (previously agreed)
  380.     function SetMediaType(mt: PAMMediaType): HRESULT; virtual;
  381.     // check that the connection is ok before verifying it
  382.     // can be overridden eg to check what interfaces will be supported.
  383.     function CheckConnect(Pin: IPin): HRESULT; virtual;
  384.     // Set and release resources required for a connection
  385.     function BreakConnect: HRESULT; virtual;
  386.     function CompleteConnect(ReceivePin: IPin): HRESULT; virtual;
  387.     // returns the preferred formats for a pin
  388.     function GetMediaType(Position: integer; out MediaType: PAMMediaType): HRESULT; virtual;
  389.     // access to NewSegment values
  390.     property CurrentStopTime: TReferenceTime read FStop;
  391.     property CurrentStartTime: TReferenceTime read FStart;
  392.     property CurrentRate: double read FRate;
  393.     //  Access name
  394.     property Name: WideString read FPinName;
  395.     property CanReconnectWhenActive: boolean read FCanReconnectWhenActive write FCanReconnectWhenActive;
  396.     // Media type
  397.     property CurrentMediaType: TBCMediaType read GetCurrentMediaType;
  398.     property AMMediaType: PAMMediaType read GetAMMediaType;
  399.   end;
  400.  
  401.   TBCEnumPins = class(TInterfacedObject, IEnumPins)
  402.   private
  403.     FPosition: integer;   // Current ordinal position
  404.     FPinCount: integer;   // Number of pins available
  405.     FFilter: TBCBaseFilter; // The filter who owns us
  406.     FVersion: LongInt;    // Pin version information
  407.     // These pointers have not been AddRef'ed and
  408.     // so they should not be dereferenced.  They are
  409.     // merely kept to ID which pins have been enumerated.
  410.     FPinCache: TList;
  411.     { If while we are retrieving a pin for example from the filter an error
  412.       occurs we assume that our internal state is stale with respect to the
  413.       filter (someone may have deleted all the pins). We can check before
  414.       starting whether or not the operation is likely to fail by asking the
  415.       filter what it's current version number is. If the filter has not
  416.       overriden the GetPinVersion method then this will always match }
  417.     function AreWeOutOfSync: boolean;
  418.  
  419.     (* This method performs the same operations as Reset, except is does not clear
  420.        the cache of pins already enumerated. *)
  421.     function Refresh: HRESULT; stdcall;
  422.   public
  423.     constructor Create(Filter: TBCBaseFilter; EnumPins: TBCEnumPins);
  424.     destructor Destroy; override;
  425.  
  426.     function Next(cPins: ULONG;  // place this many pins...
  427.       out ppPins: IPin;          // ...in this array of IPin*
  428.       pcFetched: PULONG          // actual count passed returned here
  429.       ): HRESULT; stdcall;
  430.     function Skip(cPins: ULONG): HRESULT; stdcall;
  431.     function Reset: HRESULT; stdcall;
  432.     function Clone(out ppEnum: IEnumPins): HRESULT; stdcall;
  433.   end;
  434.  
  435.   TBCEnumMediaTypes = class(TInterfacedObject, IEnumMediaTypes)
  436.   private
  437.    FPosition: Cardinal;   // Current ordinal position
  438.    FPin     : TBCBasePin; // The pin who owns us
  439.    FVersion : LongInt;    // Media type version value
  440.    function AreWeOutOfSync: boolean;
  441.   public
  442.     constructor Create(Pin: TBCBasePin; EnumMediaTypes: TBCEnumMediaTypes);
  443.     destructor Destroy; override;
  444.     function Next(cMediaTypes: ULONG; out ppMediaTypes: PAMMediaType;
  445.       pcFetched: PULONG): HRESULT; stdcall;
  446.     function Skip(cMediaTypes: ULONG): HRESULT; stdcall;
  447.     function Reset: HRESULT; stdcall;
  448.     function Clone(out ppEnum: IEnumMediaTypes): HRESULT; stdcall;
  449.   end;
  450.  
  451.  
  452.   TBCBaseOutputPin = class(TBCBasePin)
  453.   private
  454.     FAllocator: IMemAllocator;
  455.     // interface on the downstreaminput pin, set up in CheckConnect when we connect.
  456.     FInputPin : IMemInputPin;
  457.   public
  458.     constructor Create(ObjectName: string; Filter: TBCBaseFilter; Lock: TBCCritSec;
  459.       out hr: HRESULT; Name: WideString);
  460.  
  461.     // override CompleteConnect() so we can negotiate an allocator
  462.     function CompleteConnect(ReceivePin: IPin): HRESULT; override;
  463.     // negotiate the allocator and its buffer size/count and other properties
  464.     // Calls DecideBufferSize to set properties
  465.     function DecideAllocator(Pin: IMemInputPin; out Alloc: IMemAllocator): HRESULT; virtual;
  466.     // override this to set the buffer size and count. Return an error
  467.     // if the size/count is not to your liking.
  468.     // The allocator properties passed in are those requested by the
  469.     // input pin - use eg the alignment and prefix members if you have
  470.     // no preference on these.
  471.     function DecideBufferSize(Alloc: IMemAllocator; propInputRequest: PAllocatorProperties): HRESULT; virtual;
  472.  
  473.     // returns an empty sample buffer from the allocator
  474.     function GetDeliveryBuffer(out Sample: IMediaSample; StartTime: PReferenceTime;
  475.       EndTime: PReferenceTime; Flags: Longword): HRESULT; virtual;
  476.  
  477.     // deliver a filled-in sample to the connected input pin
  478.     // note - you need to release it after calling this. The receiving
  479.     // pin will addref the sample if it needs to hold it beyond the
  480.     // call.
  481.     function Deliver(Sample: IMediaSample): HRESULT; virtual;
  482.  
  483.     // override this to control the connection
  484.     function InitAllocator(out Alloc: IMemAllocator): HRESULT; virtual;
  485.     function CheckConnect(Pin: IPin): HRESULT; override;
  486.     function BreakConnect: HRESULT; override;
  487.  
  488.     // override to call Commit and Decommit
  489.     function Active: HRESULT; override;
  490.     function Inactive: HRESULT; override;
  491.  
  492.     // we have a default handling of EndOfStream which is to return
  493.     // an error, since this should be called on input pins only
  494.     function EndOfStream: HRESULT; override; stdcall;
  495.  
  496.     // called from elsewhere in our filter to pass EOS downstream to
  497.     // our connected input pin
  498.     function DeliverEndOfStream: HRESULT; virtual;
  499.  
  500.     // same for Begin/EndFlush - we handle Begin/EndFlush since it
  501.     // is an error on an output pin, and we have Deliver methods to
  502.     // call the methods on the connected pin
  503.     function BeginFlush: HRESULT; override; stdcall;
  504.     function EndFlush: HRESULT; override; stdcall;
  505.     function DeliverBeginFlush: HRESULT; virtual;
  506.     function DeliverEndFlush: HRESULT; virtual;
  507.  
  508.     // deliver NewSegment to connected pin - you will need to
  509.     // override this if you queue any data in your output pin.
  510.     function DeliverNewSegment(Start, Stop: TReferenceTime; Rate: double): HRESULT; virtual;
  511.   end;
  512.  
  513.   TBCBaseInputPin = class(TBCBasePin, IMemInputPin)
  514.   protected
  515.     FAllocator: IMemAllocator;    // Default memory allocator
  516.     // allocator is read-only, so received samples
  517.     // cannot be modified (probably only relevant to in-place
  518.     // transforms
  519.     FReadOnly: boolean;
  520.  
  521.     //private:  this should really be private... only the MPEG code
  522.     // currently looks at it directly and it should use IsFlushing().
  523.     // in flushing state (between BeginFlush and EndFlush)
  524.     // if TRUE, all Receives are returned with S_FALSE
  525.     FFlushing: boolean;
  526.  
  527.     // Sample properties - initalized in Receive
  528.  
  529.     FSampleProps: TAMSample2Properties;
  530.  
  531.   public
  532.  
  533.     constructor Create(ObjectName: string; Filter: TBCBaseFilter;
  534.       Lock: TBCCritSec; out hr: HRESULT; Name: WideString);
  535.     destructor Destroy; override;
  536.  
  537.     // ----------IMemInputPin--------------
  538.     // return the allocator interface that this input pin
  539.     // would like the output pin to use
  540.     function GetAllocator(out ppAllocator: IMemAllocator): HRESULT; stdcall;
  541.     // tell the input pin which allocator the output pin is actually
  542.     // going to use.
  543.     function NotifyAllocator(pAllocator: IMemAllocator; bReadOnly: BOOL): HRESULT; stdcall;
  544.     // this method is optional (can return E_NOTIMPL).
  545.     // default implementation returns E_NOTIMPL. Override if you have
  546.     // specific alignment or prefix needs, but could use an upstream
  547.     // allocator
  548.     function GetAllocatorRequirements(out pProps: TAllocatorProperties): HRESULT; stdcall;
  549.     // do something with this media sample
  550.     function Receive(pSample: IMediaSample): HRESULT; virtual; stdcall;
  551.     // do something with these media samples
  552.     function ReceiveMultiple(var pSamples: IMediaSample; nSamples: Longint;
  553.         out nSamplesProcessed: Longint): HRESULT; stdcall;
  554.      // See if Receive() blocks
  555.     function ReceiveCanBlock: HRESULT; stdcall;
  556.  
  557.     //-----------Helper-------------
  558.     // Default handling for BeginFlush - call at the beginning
  559.     // of your implementation (makes sure that all Receive calls
  560.     // fail). After calling this, you need to free any queued data
  561.     // and then call downstream.
  562.     function BeginFlush: HRESULT; override; stdcall;
  563.  
  564.     // default handling for EndFlush - call at end of your implementation
  565.     // - before calling this, ensure that there is no queued data and no thread
  566.     // pushing any more without a further receive, then call downstream,
  567.     // then call this method to clear the m_bFlushing flag and re-enable
  568.     // receives
  569.     function EndFlush: HRESULT; override; stdcall;
  570.  
  571.     // Release the pin's allocator.
  572.     function BreakConnect: HRESULT; override;
  573.  
  574.     // helper method to check the read-only flag
  575.     property IsReadOnly: boolean read FReadOnly;
  576.  
  577.     // helper method to see if we are flushing
  578.     property IsFlushing: boolean read FFlushing;
  579.  
  580.     //  Override this for checking whether it's OK to process samples
  581.     //  Also call this from EndOfStream.
  582.     function CheckStreaming: HRESULT; virtual;
  583.  
  584.     // Pass a Quality notification on to the appropriate sink
  585.     function PassNotify(const q: TQuality): HRESULT;
  586.  
  587.  
  588.     //================================================================================
  589.     // IQualityControl methods (from CBasePin)
  590.     //================================================================================
  591.  
  592.     function Notify(pSelf: IBaseFilter; q: TQuality): HRESULT; override; stdcall;
  593.  
  594.     // no need to override:
  595.     // STDMETHODIMP SetSink(IQualityControl * piqc);
  596.  
  597.     // switch the pin to inactive state - may already be inactive
  598.     function Inactive: HRESULT; override;
  599.  
  600.     // Return sample properties pointer
  601.     function SampleProps: PAMSample2Properties;
  602.   end;
  603.  
  604.   TBCTransformOutputPin = class;
  605.   TBCTransformInputPin  = class;
  606.  
  607.   TBCTransformFilter = class(TBCBaseFilter)
  608.   protected
  609.     FEOSDelivered  : boolean; // have we sent EndOfStream
  610.     FSampleSkipped : boolean; // Did we just skip a frame
  611.     FQualityChanged: boolean; // Have we degraded?
  612.     // critical section protecting filter state.
  613.     FcsFilter: TBCCritSec;
  614.     // critical section stopping state changes (ie Stop) while we're
  615.     // processing a sample.
  616.     //
  617.     // This critical section is held when processing
  618.     // events that occur on the receive thread - Receive() and EndOfStream().
  619.     //
  620.     // If you want to hold both m_csReceive and m_csFilter then grab
  621.     // m_csFilter FIRST - like CTransformFilter::Stop() does.
  622.     FcsReceive: TBCCritSec;
  623.     // these hold our input and output pins
  624.     FInput : TBCTransformInputPin;
  625.     FOutput: TBCTransformOutputPin;
  626.   public
  627.     // map getpin/getpincount for base enum of pins to owner
  628.     // override this to return more specialised pin objects
  629.  
  630.     function GetPinCount: integer; override;
  631.     function GetPin(n: integer): TBCBasePin; override;
  632.     function FindPin(Id: PWideChar; out ppPin: IPin): HRESULT; override; stdcall;
  633.  
  634.     // override state changes to allow derived transform filter
  635.     // to control streaming start/stop
  636.     function Stop: HRESULT; override; stdcall;
  637.     function Pause: HRESULT; override; stdcall;
  638.  
  639.     constructor Create(ObjectName: string; unk: IUnKnown; const clsid: TGUID);
  640.     constructor CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown); override;
  641.     destructor destroy; override;
  642.  
  643.     // =================================================================
  644.     // ----- override these bits ---------------------------------------
  645.     // =================================================================
  646.  
  647.     // These must be supplied in a derived class
  648.     function Transform(msIn, msout: IMediaSample): HRESULT; virtual;
  649.  
  650.     // check if you can support mtIn
  651.     function CheckInputType(mtIn: PAMMediaType): HRESULT; virtual; abstract;
  652.  
  653.     // check if you can support the transform from this input to this output
  654.     function CheckTransform(mtIn, mtOut: PAMMediaType): HRESULT; virtual; abstract;
  655.  
  656.     // this goes in the factory template table to create new instances
  657.     // static CCOMObject * CreateInstance(LPUNKNOWN, HRESULT *);
  658.  
  659.     // call the SetProperties function with appropriate arguments
  660.     function DecideBufferSize(Allocator: IMemAllocator; prop: PAllocatorProperties): HRESULT; virtual; abstract;
  661.  
  662.     // override to suggest OUTPUT pin media types
  663.     function GetMediaType(Position: integer; out MediaType: PAMMediaType): HRESULT; virtual; abstract;
  664.  
  665.  
  666.  
  667.     // =================================================================
  668.     // ----- Optional Override Methods           -----------------------
  669.     // =================================================================
  670.  
  671.     // you can also override these if you want to know about streaming
  672.     function StartStreaming: HRESULT; virtual;
  673.     function StopStreaming: HRESULT; virtual;
  674.  
  675.     // override if you can do anything constructive with quality notifications
  676.     function AlterQuality(const q: TQuality): HRESULT; virtual;
  677.  
  678.     // override this to know when the media type is actually set
  679.     function SetMediaType(direction: TPinDirection; pmt: PAMMediaType): HRESULT; virtual;
  680.  
  681.     // chance to grab extra interfaces on connection
  682.     function CheckConnect(dir: TPinDirection; Pin: IPin): HRESULT; virtual;
  683.     function BreakConnect(dir: TPinDirection): HRESULT; virtual;
  684.     function CompleteConnect(direction: TPinDirection; ReceivePin: IPin): HRESULT; virtual;
  685.  
  686.     // chance to customize the transform process
  687.     function Receive(Sample: IMediaSample): HRESULT; virtual;
  688.  
  689.     // Standard setup for output sample
  690.     function InitializeOutputSample(Sample: IMediaSample; out OutSample: IMediaSample): HRESULT;
  691.  
  692.     // if you override Receive, you may need to override these three too
  693.     function EndOfStream: HRESULT; virtual;
  694.     function BeginFlush: HRESULT; virtual;
  695.     function EndFlush: HRESULT; virtual;
  696.     function NewSegment(Start, Stop: TReferenceTime; Rate: double): HRESULT; virtual;
  697.  
  698.     property Input: TBCTransformInputPin read FInput write FInput;
  699.     property Output: TBCTransformOutputPin read FOutPut write FOutput;
  700.  
  701.   end;
  702.  
  703.   TBCTransformInputPin = class(TBCBaseInputPin)
  704.   private
  705.     FTransformFilter: TBCTransformFilter;
  706.   public
  707.     constructor Create(ObjectName: string; TransformFilter: TBCTransformFilter;
  708.       out hr: HRESULT; Name: WideString);
  709.  
  710.     destructor destroy; override;
  711.     function QueryId(out id: PWideChar): HRESULT; override; stdcall;
  712.  
  713.  
  714.     // Grab and release extra interfaces if required
  715.  
  716.     function CheckConnect(Pin: IPin): HRESULT; override;
  717.     function BreakConnect: HRESULT; override;
  718.     function CompleteConnect(ReceivePin: IPin): HRESULT; override;
  719.  
  720.     // check that we can support this output type
  721.     function CheckMediaType(mtIn: PAMMediaType): HRESULT; override;
  722.  
  723.     // set the connection media type
  724.     function SetMediaType(mt: PAMMediaType): HRESULT; override;
  725.  
  726.     // --- IMemInputPin -----
  727.  
  728.     // here's the next block of data from the stream.
  729.     // AddRef it yourself if you need to hold it beyond the end
  730.     // of this call.
  731.     function Receive(pSample: IMediaSample): HRESULT; override; stdcall;
  732.  
  733.     // provide EndOfStream that passes straight downstream
  734.     // (there is no queued data)
  735.     function EndOfStream: HRESULT; override; stdcall;
  736.  
  737.     // passes it to CTransformFilter::BeginFlush
  738.     function BeginFlush: HRESULT; override; stdcall;
  739.  
  740.     // passes it to CTransformFilter::EndFlush
  741.     function EndFlush: HRESULT; override; stdcall;
  742.  
  743.     function NewSegment(Start, Stop: TReferenceTime; Rate: double): HRESULT; override; stdcall;
  744.  
  745.     // Check if it's OK to process samples
  746.     function CheckStreaming: HRESULT; override;
  747.   end;
  748.  
  749.   TBCTransformOutputPin = class(TBCBaseOutputPin)
  750.   private
  751.     FTransformFilter: TBCTransformFilter;
  752.     // implement IMediaPosition by passing upstream
  753.     FPosition: IUnknown;
  754.   public
  755.     constructor Create(ObjectName: string; TransformFilter: TBCTransformFilter;
  756.       out hr: HRESULT; Name: WideString);
  757.     destructor destroy; override;
  758.     // override to expose IMediaPosition
  759.     function NonDelegatingQueryInterface(const IID: TGUID; out Obj): HResult; override;
  760.  
  761.     // --- TBCBaseOutputPin ------------
  762.  
  763.     function QueryId(out Id: PWideChar): HRESULT; override; stdcall;
  764.     // Grab and release extra interfaces if required
  765.     function CheckConnect(Pin: IPin): HRESULT; override;
  766.     function BreakConnect: HRESULT; override;
  767.     function CompleteConnect(ReceivePin: IPin): HRESULT; override;
  768.  
  769.     // check that we can support this output type
  770.     function CheckMediaType(mtOut: PAMMediaType): HRESULT; override;
  771.  
  772.     // set the connection media type
  773.     function SetMediaType(pmt: PAMMediaType): HRESULT; override;
  774.  
  775.     // called from CBaseOutputPin during connection to ask for
  776.     // the count and size of buffers we need.
  777.     function DecideBufferSize(Alloc: IMemAllocator; Prop: PAllocatorProperties): HRESULT; override;
  778.  
  779.     // returns the preferred formats for a pin
  780.     function GetMediaType(Position: integer; out MediaType: PAMMediaType): HRESULT; override;
  781.  
  782.     // inherited from IQualityControl via CBasePin
  783.     function Notify(Sendr: IBaseFilter; q: TQuality): HRESULT; override; stdcall;
  784.   end;
  785.  
  786.   TBCTransInPlaceOutputPin = class;
  787.   TBCTransInPlaceInputPin  = class;
  788.  
  789.   TBCTransInPlaceFilter = class(TBCTransformFilter)
  790.   public
  791.     // map getpin/getpincount for base enum of pins to owner
  792.     // override this to return more specialised pin objects
  793.     function GetPin(n: integer): TBCBasePin; override;
  794.  
  795.     //  Set bModifiesData == false if your derived filter does
  796.     //  not modify the data samples (for instance it's just copying
  797.     //  them somewhere else or looking at the timestamps).
  798.     constructor Create(ObjectName: string; unk: IUnKnown; clsid: TGUID;
  799.       out hr: HRESULT; ModifiesData: boolean = true);
  800.  
  801.     constructor CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown); override;
  802.  
  803.     // The following are defined to avoid undefined pure virtuals.
  804.     // Even if they are never called, they will give linkage warnings/errors
  805.  
  806.     // We override EnumMediaTypes to bypass the transform class enumerator
  807.     // which would otherwise call this.
  808.     function GetMediaType(Position: integer; out MediaType: PAMMediaType): HRESULT; override;
  809.  
  810.     // This is called when we actually have to provide out own allocator.
  811.     function DecideBufferSize(Alloc: IMemAllocator; propInputRequest: PAllocatorProperties): HRESULT; override;
  812.  
  813.     // The functions which call this in CTransform are overridden in this
  814.     // class to call CheckInputType with the assumption that the type
  815.     // does not change.  In Debug builds some calls will be made and
  816.     // we just ensure that they do not assert.
  817.     function CheckTransform(mtIn, mtOut: PAMMediaType): HRESULT; override;
  818.  
  819.     // =================================================================
  820.     // ----- You may want to override this -----------------------------
  821.     // =================================================================
  822.  
  823.     function CompleteConnect(dir: TPinDirection; ReceivePin: IPin): HRESULT; override;
  824.  
  825.     // chance to customize the transform process
  826.     function Receive(Sample: IMediaSample): HRESULT; override;
  827.  
  828.     // =================================================================
  829.     // ----- You MUST override these -----------------------------------
  830.     // =================================================================
  831.  
  832.     function Transform(Sample: IMediaSample): HRESULT; reintroduce; virtual; abstract;
  833.  
  834.     // this goes in the factory template table to create new instances
  835.     // static CCOMObject * CreateInstance(LPUNKNOWN, HRESULT *);
  836.  
  837.   protected
  838.     FModifiesData: boolean; // Does this filter change the data?
  839.     function Copy(Source: IMediaSample): IMediaSample;
  840.  
  841.     // these hold our input and output pins
  842.     function InputPin: TBCTransInPlaceInputPin;
  843.     function OutputPin: TBCTransInPlaceOutputPin;
  844.  
  845.     //  Helper to see if the input and output types match
  846.     function TypesMatch: boolean;
  847.  
  848.     //  Are the input and output allocators different?
  849.     function UsingDifferentAllocators: boolean;
  850.   end;
  851.  
  852.   TBCTransInPlaceInputPin = class(TBCTransformInputPin)
  853.   protected
  854.     FTIPFilter: TBCTransInPlaceFilter; // our filter
  855.     FReadOnly : boolean;               // incoming stream is read only
  856.   public
  857.     constructor Create(ObjectName: string; Filter: TBCTransInPlaceFilter;
  858.       out hr: HRESULT; Name: WideString);
  859.     // --- IMemInputPin -----
  860.     // Provide an enumerator for media types by getting one from downstream
  861.     function EnumMediaTypes(out ppEnum: IEnumMediaTypes): HRESULT; override; stdcall;
  862.  
  863.     // Say whether media type is acceptable.
  864.     function CheckMediaType(pmt: PAMMediaType): HRESULT; override;
  865.  
  866.     // Return our upstream allocator
  867.     function GetAllocator(out Allocator: IMemAllocator): HRESULT; stdcall;
  868.  
  869.     // get told which allocator the upstream output pin is actually
  870.     // going to use.
  871.     function NotifyAllocator(Allocator: IMemAllocator; ReadOnly: BOOL): HRESULT; stdcall;
  872.  
  873.     // Allow the filter to see what allocator we have
  874.     // N.B. This does NOT AddRef
  875.     function PeekAllocator: IMemAllocator;
  876.  
  877.     // Pass this on downstream if it ever gets called.
  878.     function GetAllocatorRequirements(props: PAllocatorProperties): HRESULT; stdcall;
  879.  
  880.     property ReadOnly: Boolean read FReadOnly;
  881.   end;
  882.  
  883.  
  884. // ==================================================
  885. // Implements the output pin
  886. // ==================================================
  887.  
  888.   TBCTransInPlaceOutputPin = class(TBCTransformOutputPin)
  889.   protected
  890.     // m_pFilter points to our CBaseFilter
  891.     FTIPFilter: TBCTransInPlaceFilter;
  892.   public
  893.     constructor Create(ObjectName: string; Filter: TBCTransInPlaceFilter;
  894.       out hr: HRESULT; Name: WideString);
  895.  
  896.     // --- CBaseOutputPin ------------
  897.  
  898.     // negotiate the allocator and its buffer size/count
  899.     // Insists on using our own allocator.  (Actually the one upstream of us).
  900.     // We don't override this - instead we just agree the default
  901.     // then let the upstream filter decide for itself on reconnect
  902.     // virtual HRESULT DecideAllocator(IMemInputPin * pPin, IMemAllocator ** pAlloc);
  903.  
  904.     // Provide a media type enumerator.  Get it from upstream.
  905.     function EnumMediaTypes(out ppEnum: IEnumMediaTypes): HRESULT; override; stdcall;
  906.  
  907.     // Say whether media type is acceptable.
  908.     function CheckMediaType(pmt: PAMMediaType): HRESULT; override;
  909.  
  910.     //  This just saves the allocator being used on the output pin
  911.     //  Also called by input pin's GetAllocator()
  912.     procedure SetAllocator(Allocator: IMemAllocator);
  913.  
  914.     function ConnectedIMemInputPin: IMemInputPin;
  915.  
  916.     // Allow the filter to see what allocator we have
  917.     // N.B. This does NOT AddRef
  918.     function PeekAllocator: IMemAllocator;
  919.   end;
  920.  
  921.  
  922.   TBCBasePropertyPage = class(TBCUnknown, IPropertyPage)
  923.   private
  924.     FObjectSet: boolean;          // SetObject has been called or not.
  925.   protected
  926.     FPageSite: IPropertyPageSite; // Details for our property site
  927.     FDirty: boolean;              // Has anything been changed
  928.     FForm: TFormPropertyPage;
  929.   public
  930.     constructor Create(Name: String; Unk: IUnKnown; Form: TFormPropertyPage);
  931.     destructor  Destroy; override;
  932.     procedure SetPageDirty;
  933.  
  934.     { IPropertyPage }
  935.     function SetPageSite(const pageSite: IPropertyPageSite): HResult; stdcall;
  936.     function Activate(hwndParent: HWnd; const rc: TRect; bModal: BOOL): HResult; stdcall;
  937.     function Deactivate: HResult; stdcall;
  938.     function GetPageInfo(out pageInfo: TPropPageInfo): HResult; stdcall;
  939.     function SetObjects(cObjects: Longint; pUnkList: PUnknownList): HResult; stdcall;
  940.     function Show(nCmdShow: Integer): HResult; stdcall;
  941.     function Move(const rect: TRect): HResult; stdcall;
  942.     function IsPageDirty: HResult; stdcall;
  943.     function Apply: HResult; stdcall;
  944.     function Help(pszHelpDir: POleStr): HResult; stdcall;
  945.     function TranslateAccelerator(msg: PMsg): HResult; stdcall;
  946.   end;
  947.  
  948.   TOnConnect = procedure(sender: Tobject; Unknown: IUnknown) of object;
  949.  
  950.   TFormPropertyPage = class(TForm, IUnKnown, IPropertyPage)
  951.   private
  952.     FPropertyPage: TBCBasePropertyPage;
  953.   published
  954.     function OnConnect(Unknown: IUnknown): HRESULT; virtual;
  955.     function OnDisconnect: HRESULT; virtual;
  956.     function OnApplyChanges: HRESULT; virtual;
  957.     property PropertyPage   : TBCBasePropertyPage read FPropertyPage implements IUnKnown, IPropertyPage;
  958.   end;
  959.  
  960.   TBCBaseDispatch = class{IDispatch}
  961.   protected
  962.     FTI: ITypeInfo;
  963.   public
  964.     // IDispatch methods
  965.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  966.     function GetTypeInfo(const iid: TGUID; info: Cardinal; lcid: LCID; out tinfo): HRESULT; stdcall;
  967.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  968.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  969.   end;
  970.  
  971.   TBCMediaControl = class(TBCUnknown, IDispatch)
  972.   public
  973.     FBaseDisp: TBCBaseDispatch;
  974.     constructor Create(name: string; unk: IUnknown);
  975.     destructor Destroy; override;
  976.  
  977.     // IDispatch methods
  978.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  979.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  980.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  981.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  982.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  983.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  984.   end;
  985.  
  986.   TBCMediaEvent = class(TBCUnknown, IDisPatch{,IMediaEventEx})
  987.   protected
  988.     FBasedisp: TBCBaseDispatch;
  989.   public
  990.     constructor Create(Name: string; Unk: IUnknown);
  991.     destructor destroy; override;
  992.     // IDispatch methods
  993.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  994.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  995.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  996.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  997.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  998.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  999.   end;
  1000.  
  1001.   TBCMediaPosition = class(TBCUnknown, IDispatch {IMediaPosition})
  1002.   protected
  1003.     FBaseDisp: TBCBaseDispatch;
  1004.   public
  1005.     constructor Create(Name: String; Unk: IUnknown); overload;
  1006.     constructor Create(Name: String; Unk: IUnknown; out hr: HRESULT); overload;
  1007.     destructor Destroy; override;
  1008.     // IDispatch methods
  1009.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  1010.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  1011.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  1012.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  1013.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  1014.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  1015.   end;
  1016.  
  1017.  
  1018. // A utility class that handles IMediaPosition and IMediaSeeking on behalf
  1019. // of single-input pin renderers, or transform filters.
  1020. //
  1021. // Renderers will expose this from the filter; transform filters will
  1022. // expose it from the output pin and not the renderer.
  1023. //
  1024. // Create one of these, giving it your IPin* for your input pin, and delegate
  1025. // all IMediaPosition methods to it. It will query the input pin for
  1026. // IMediaPosition and respond appropriately.
  1027. //
  1028. // Call ForceRefresh if the pin connection changes.
  1029. //
  1030. // This class no longer caches the upstream IMediaPosition or IMediaSeeking
  1031. // it acquires it on each method call. This means ForceRefresh is not needed.
  1032. // The method is kept for source compatibility and to minimise the changes
  1033. // if we need to put it back later for performance reasons.
  1034.  
  1035.   TBCPosPassThru = class(TBCMediaPosition, IMediaSeeking)
  1036.   protected
  1037.     FPin: IPin;
  1038.     function GetPeer(out MP: IMediaPosition): HRESULT;
  1039.     function GetPeerSeeking(out MS: IMediaSeeking): HRESULT;
  1040.   public
  1041.  
  1042.     constructor Create(name: String; Unk: IUnknown; out hr: HRESULT; Pin: IPin);
  1043.     function ForceRefresh: HRESULT;{return S_OK;}
  1044.  
  1045.     // override to return an accurate current position
  1046.     function GetMediaTime(out StartTime, EndTime: int64): HRESULT; virtual;
  1047.  
  1048.     // IMediaSeeking methods
  1049.     function GetCapabilities(out pCapabilities: DWORD): HRESULT; stdcall;
  1050.     function CheckCapabilities(var pCapabilities: DWORD): HRESULT; stdcall;
  1051.     function IsFormatSupported(const pFormat: TGUID): HRESULT; stdcall;
  1052.     function QueryPreferredFormat(out pFormat: TGUID): HRESULT; stdcall;
  1053.     function GetTimeFormat(out pFormat: TGUID): HRESULT; stdcall;
  1054.     function IsUsingTimeFormat(const pFormat: TGUID): HRESULT; stdcall;
  1055.     function SetTimeFormat(const pFormat: TGUID): HRESULT; stdcall;
  1056.     function GetDuration(out pDuration: int64): HRESULT; stdcall;
  1057.     function GetStopPosition(out pStop: int64): HRESULT; stdcall;
  1058.     function GetCurrentPosition(out pCurrent: int64): HRESULT; stdcall;
  1059.     function ConvertTimeFormat(out pTarget: int64; pTargetFormat: PGUID;
  1060.                Source: int64; pSourceFormat: PGUID): HRESULT; stdcall;
  1061.     function SetPositions(var pCurrent: int64; dwCurrentFlags: DWORD;
  1062.                var pStop: int64; dwStopFlags: DWORD): HRESULT; stdcall;
  1063.     function GetPositions(out pCurrent, pStop: int64): HRESULT; stdcall;
  1064.     function GetAvailable(out pEarliest, pLatest: int64): HRESULT; stdcall;
  1065.     function SetRate(dRate: double): HRESULT; stdcall;
  1066.     function GetRate(out pdRate: double): HRESULT; stdcall;
  1067.     function GetPreroll(out pllPreroll: int64): HRESULT; stdcall;
  1068.  
  1069.     // IMediaPosition properties
  1070.     function get_Duration(out plength: TRefTime): HResult; stdcall;
  1071.     function put_CurrentPosition(llTime: TRefTime): HResult; stdcall;
  1072.     function get_CurrentPosition(out pllTime: TRefTime): HResult; stdcall;
  1073.     function get_StopTime(out pllTime: TRefTime): HResult; stdcall;
  1074.     function put_StopTime(llTime: TRefTime): HResult; stdcall;
  1075.     function get_PrerollTime(out pllTime: TRefTime): HResult; stdcall;
  1076.     function put_PrerollTime(llTime: TRefTime): HResult; stdcall;
  1077.     function put_Rate(dRate: double): HResult; stdcall;
  1078.     function get_Rate(out pdRate: double): HResult; stdcall;
  1079.     function CanSeekForward(out pCanSeekForward: Longint): HResult; stdcall;
  1080.     function CanSeekBackward(out pCanSeekBackward: Longint): HResult; stdcall;
  1081.   end;
  1082.  
  1083.   TBCRendererPosPassThru = class(TBCPosPassThru)
  1084.   protected
  1085.     FPositionLock: TBCCritSec; // Locks access to our position
  1086.     FStartMedia  : Int64;      // Start media time last seen
  1087.     FEndMedia    : Int64;      // And likewise the end media
  1088.     FReset       : boolean;    // Have media times been set
  1089.   public
  1090.     // Used to help with passing media times through graph
  1091.     constructor Create(name: String; Unk: IUnknown; out hr: HRESULT; Pin: IPin); reintroduce;
  1092.     destructor destroy; override;
  1093.  
  1094.     function RegisterMediaTime(MediaSample: IMediaSample): HRESULT; overload;
  1095.     function RegisterMediaTime(StartTime, EndTime: int64): HRESULT; overload;
  1096.     function GetMediaTime(out StartTime, EndTime: int64): HRESULT; override;
  1097.     function ResetMediaTime: HRESULT;
  1098.     function EOS: HRESULT;
  1099.   end;
  1100.  
  1101.   // wrapper for event objects
  1102.   TBCAMEvent = class
  1103.   protected
  1104.     FEvent: THANDLE;
  1105.   public
  1106.     constructor Create(ManualReset: boolean = false);
  1107.     destructor destroy; override;
  1108.     property Handle: THandle read FEvent;
  1109.     procedure SetEv;
  1110.     function Wait(Timeout: Cardinal = INFINITE): boolean;
  1111.     procedure Reset;
  1112.     function Check: boolean;
  1113.   end;
  1114.  
  1115.  
  1116.   TBCRenderedInputPin = class(TBCBaseInputPin)
  1117.   private
  1118.     procedure DoCompleteHandling;
  1119.   protected
  1120.     // Member variables to track state
  1121.     FAtEndOfStream    : boolean; // Set by EndOfStream
  1122.     FCompleteNotified : boolean; // Set when we notify for EC_COMPLETE
  1123.   public
  1124.     constructor Create(ObjectName: string; Filter: TBCBaseFilter;
  1125.       Lock: TBCCritSec; out hr: HRESULT; Name: WideString);
  1126.  
  1127.     // Override methods to track end of stream state
  1128.     function EndOfStream: HRESULT; override; stdcall;
  1129.     function EndFlush: HRESULT; override; stdcall;
  1130.  
  1131.     function Active: HRESULT; override;
  1132.     function Run(Start: TReferenceTime): HRESULT; override;
  1133.   end;
  1134.  
  1135.  
  1136. function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
  1137. function DllCanUnloadNow: HResult; stdcall;
  1138. function DllRegisterServer: HResult; stdcall;
  1139. function DllUnregisterServer: HResult; stdcall;
  1140.  
  1141. procedure DbgLog(obj: TBCBaseObJect; msg: string);
  1142. {
  1143. function MTEqual(MT1, MT2: PAMMediaType): boolean;
  1144. function MTMatchesPartial(Source, Partial: PAMMediaType): boolean;
  1145. function MTIsPartiallySpecified(mt: PAMMediaType): boolean;
  1146. function MTIsValid(mt: PAMMediaType): boolean;
  1147. procedure MTInitMediaType(mt: PAMMediaType);  }
  1148.  
  1149. implementation
  1150. //uses ComObj;
  1151.  
  1152. var
  1153.   ObjectCount  : Integer;
  1154.   FactoryCount : Integer;
  1155.   TemplatesVar : TBCFilterTemplate;
  1156.  
  1157. {$IFDEF DEBUG}
  1158.   DebugLog: TStringList;
  1159. {$ENDIF}
  1160.  
  1161.   procedure DbgLog(obj: TBCBaseObJect; msg: string);
  1162.   begin
  1163.     {$IFDEF DEBUG}
  1164.     if obj = nil then DebugLog.Add(TimeToStr(time) +' > '+ msg) else
  1165.       DebugLog.Add(TimeToStr(time) +' > '+ format('Object: %s, msg: %s.',[obj.FName, msg]));
  1166.       OutputDebugString(PChar(DebugLog.Strings[DebugLog.Count-1]));
  1167.     {$ENDIF}
  1168.  
  1169.   end;
  1170.  
  1171. // -----------------------------------------------------------------------------
  1172. //  TBCMediaType
  1173. // -----------------------------------------------------------------------------
  1174.  
  1175.   function TBCMediaType.Equal(mt: TBCMediaType): boolean;
  1176.   begin
  1177.     result := ((IsEqualGUID(Mediatype.majortype,mt.MediaType.majortype) = TRUE) and
  1178.         (IsEqualGUID(Mediatype.subtype,mt.MediaType.subtype) = TRUE) and
  1179.         (IsEqualGUID(Mediatype.formattype,mt.MediaType.formattype) = TRUE) and
  1180.         (Mediatype.cbFormat = mt.MediaType.cbFormat) and
  1181.         ( (Mediatype.cbFormat = 0) or
  1182.           (CompareMem(Mediatype.pbFormat, mt.MediaType.pbFormat, Mediatype.cbFormat))));
  1183.   end;
  1184.  
  1185.   function TBCMediaType.Equal(mt: PAMMediaType): boolean;
  1186.   begin
  1187.     result := ((IsEqualGUID(Mediatype.majortype,mt.majortype) = TRUE) and
  1188.         (IsEqualGUID(Mediatype.subtype,mt.subtype) = TRUE) and
  1189.         (IsEqualGUID(Mediatype.formattype,mt.formattype) = TRUE) and
  1190.         (Mediatype.cbFormat = mt.cbFormat) and
  1191.         ( (Mediatype.cbFormat = 0) or
  1192.           (CompareMem(Mediatype.pbFormat, mt.pbFormat, Mediatype.cbFormat))));
  1193.   end;
  1194.  
  1195.   function TBCMediaType.MatchesPartial(Partial: PAMMediaType): boolean;
  1196.   begin
  1197.     result := false;
  1198.     if (not IsEqualGUID(partial.majortype, GUID_NULL) and
  1199.         not IsEqualGUID(MediaType.majortype, partial.majortype)) then exit;
  1200.  
  1201.     if (not IsEqualGUID(partial.subtype, GUID_NULL) and
  1202.         not IsEqualGUID(MediaType.subtype, partial.subtype)) then exit;
  1203.  
  1204.     if not IsEqualGUID(partial.formattype, GUID_NULL) then
  1205.     begin
  1206.       if not IsEqualGUID(MediaType.formattype, partial.formattype) then exit;
  1207.       if (MediaType.cbFormat <> partial.cbFormat) then exit;
  1208.       if ((MediaType.cbFormat <> 0) and
  1209.           (CompareMem(MediaType.pbFormat, partial.pbFormat, MediaType.cbFormat) <> false)) then exit;
  1210.     end;
  1211.     result := true;
  1212.   end;
  1213.  
  1214.   function TBCMediaType.IsPartiallySpecified: boolean;
  1215.   begin
  1216.     if (IsEqualGUID(Mediatype.majortype, GUID_NULL) or
  1217.         IsEqualGUID(Mediatype.formattype, GUID_NULL)) then result := true
  1218.                                                else result := false;
  1219.   end;
  1220.  
  1221.   function TBCMediaType.IsValid: boolean;
  1222.   begin
  1223.     result := not IsEqualGUID(MediaType.majortype,GUID_NULL);
  1224.   end;
  1225.  
  1226.   procedure TBCMediaType.InitMediaType;
  1227.   begin
  1228.     ZeroMemory(MediaType, sizeof(TAMMediaType));
  1229.     MediaType.lSampleSize := 1;
  1230.     MediaType.bFixedSizeSamples := TRUE;
  1231.   end;
  1232.  
  1233.   function TBCMediaType.FormatLength: Cardinal;
  1234.   begin
  1235.     result := MediaType.cbFormat
  1236.   end;
  1237. {
  1238.   function MTMatchesPartial(Source, Partial: PAMMediaType): boolean;
  1239.   begin
  1240.     result := false;
  1241.     if (not IsEqualGUID(partial.majortype, GUID_NULL) and
  1242.         not IsEqualGUID(Source.majortype, partial.majortype)) then exit;
  1243.  
  1244.     if (not IsEqualGUID(partial.subtype, GUID_NULL) and
  1245.         not IsEqualGUID(Source.subtype, partial.subtype)) then exit;
  1246.  
  1247.     if not IsEqualGUID(partial.formattype, GUID_NULL) then
  1248.     begin
  1249.       if not IsEqualGUID(Source.formattype, partial.formattype) then exit;
  1250.       if (Source.cbFormat <> partial.cbFormat) then exit;
  1251.       if ((Source.cbFormat <> 0) and
  1252.           (CompareMem(Source.pbFormat, partial.pbFormat, Source.cbFormat) <> false)) then exit;
  1253.     end;
  1254.     result := true;
  1255.   end;
  1256.  
  1257.   function MTIsPartiallySpecified(mt: PAMMediaType): boolean;
  1258.   begin
  1259.     if (IsEqualGUID(mt.majortype, GUID_NULL) or
  1260.         IsEqualGUID(mt.formattype, GUID_NULL)) then result := true
  1261.                                                else result := false;
  1262.   end;
  1263.  
  1264.   function MTEqual(MT1, MT2: PAMMediaType): boolean;
  1265.   begin
  1266.     // I don't believe we need to check sample size or
  1267.     // temporal compression flags, since I think these must
  1268.     // be represented in the type, subtype and format somehow. They
  1269.     // are pulled out as separate flags so that people who don't understand
  1270.     // the particular format representation can still see them, but
  1271.     // they should duplicate information in the format block.
  1272.     result := ((IsEqualGUID(MT1.majortype,MT2.majortype) = TRUE) and
  1273.         (IsEqualGUID(MT1.subtype,MT2.subtype) = TRUE) and
  1274.         (IsEqualGUID(MT1.formattype,MT2.formattype) = TRUE) and
  1275.         (MT1.cbFormat = MT2.cbFormat) and
  1276.         ( (MT1.cbFormat = 0) or
  1277.           (CompareMem(MT1.pbFormat, MT2.pbFormat, MT1.cbFormat))));
  1278.   end;
  1279.  
  1280.   function MTIsValid(mt: PAMMediaType): boolean;
  1281.   begin
  1282.     result := not IsEqualGUID(mt.majortype,GUID_NULL);
  1283.   end;
  1284.  
  1285.   procedure MTInitMediaType(mt: PAMMediaType);
  1286.   begin
  1287.     ZeroMemory(mt, sizeof(TAMMediaType));
  1288.     mt.lSampleSize := 1;
  1289.     mt.bFixedSizeSamples := TRUE;
  1290.   end;   }
  1291.  
  1292. // -----------------------------------------------------------------------------
  1293.  
  1294.   function AMGetWideString(Source: WideString; out Dest: PWideChar): HRESULT;
  1295.   type TWideCharArray = array of WideChar;
  1296.   var NameLen: Cardinal;
  1297.   begin
  1298.     if Source = '' then
  1299.       begin
  1300.         dest := nil;
  1301.         result := S_OK;
  1302.         exit;
  1303.       end;
  1304.     assert(@dest <> nil);
  1305.     nameLen := (length(Source)+1)*2;
  1306.     Dest := CoTaskMemAlloc(nameLen);
  1307.     if(Dest = nil) then
  1308.     begin
  1309.       result := E_OUTOFMEMORY;
  1310.       exit;
  1311.     end;
  1312.     CopyMemory(dest, pointer(Source), nameLen-1);
  1313.     TWideCharArray(dest)[(nameLen div 2)-1] := #0;
  1314.     result := NOERROR;
  1315.   end;
  1316.  
  1317. // -----------------------------------------------------------------------------
  1318.  
  1319.  
  1320. function CreateMemoryAllocator(out Allocator: IMemAllocator): HRESULT;
  1321. begin
  1322.   result := CoCreateInstance(CLSID_MemoryAllocator, nil, CLSCTX_INPROC_SERVER,
  1323.     IID_IMemAllocator, Allocator);
  1324. end;
  1325.  
  1326. //  Put this one here rather than in ctlutil.cpp to avoid linking
  1327. //  anything brought in by ctlutil.cpp
  1328. function CreatePosPassThru(Agg: IUnknown; Renderer: boolean; Pin: IPin; out PassThru: IUnknown): HRESULT; stdcall;
  1329. var
  1330.   UnkSeek: IUnknown;
  1331.   APassThru: ISeekingPassThru;
  1332. begin
  1333.   PassThru := nil;
  1334.  
  1335.   result := CoCreateInstance(CLSID_SeekingPassThru, Agg, CLSCTX_INPROC_SERVER,
  1336.     IUnknown, UnkSeek);
  1337.   if FAILED(result) then exit;
  1338.  
  1339.   result := UnkSeek.QueryInterface(IID_ISeekingPassThru, APassThru);
  1340.   if FAILED(result) then
  1341.     begin
  1342.       UnkSeek := nil;
  1343.       exit;
  1344.     end;
  1345.  
  1346.   result := APassThru.Init(Renderer, Pin);
  1347.   APassThru := nil;
  1348.   if FAILED(result) then
  1349.     begin
  1350.       UnkSeek := nil;
  1351.       exit;
  1352.     end;
  1353.  
  1354.   PassThru := UnkSeek;
  1355.   result := S_OK;
  1356. end;
  1357.  
  1358. // -----------------------------------------------------------------------------
  1359.  
  1360.   function Templates: TBCFilterTemplate;
  1361.   begin
  1362.     if TemplatesVar = nil then TemplatesVar := TBCFilterTemplate.Create;
  1363.     result := TemplatesVar;
  1364.   end;
  1365.  
  1366.   function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
  1367.   var
  1368.     Factory: TBCClassFactory;
  1369.   begin
  1370.     Factory := Templates.GetFactoryFromClassID(CLSID);
  1371.     if Factory <> nil then
  1372.       if Factory.GetInterface(IID, Obj) then
  1373.         Result := S_OK
  1374.       else
  1375.         Result := E_NOINTERFACE
  1376.     else
  1377.     begin
  1378.       Pointer(Obj) := nil;
  1379.       Result := CLASS_E_CLASSNOTAVAILABLE;
  1380.     end;
  1381.   end;
  1382.  
  1383.   function DllCanUnloadNow: HResult; stdcall;
  1384.   begin
  1385.     if (ObjectCount = 0) and (FactoryCount = 0) then
  1386.       result := S_OK else result := S_FALSE;;
  1387.   end;
  1388.  
  1389.   function DllRegisterServer: HResult; stdcall;
  1390.   begin
  1391.     if Templates.RegisterServer(true) then result := S_OK else result := E_FAIL;
  1392.   end;
  1393.  
  1394.   function DllUnregisterServer: HResult; stdcall;
  1395.   begin
  1396.     if Templates.RegisterServer(false) then result := S_OK else result := E_FAIL;
  1397.   end;
  1398.  
  1399. { TBCClassFactory }
  1400.  
  1401. constructor TBCClassFactory.CreateFilter(ComClass: TBCUnknownClass; Name: string;
  1402.   const ClassID: TGUID; const Category: TGUID; Merit: LongWord;
  1403.   PinCount: Cardinal; Pins: PRegFilterPins);
  1404. begin
  1405.   Templates.AddObjectFactory(Self);
  1406.   FComClass := ComClass;
  1407.   FName     := Name;
  1408.   FClassID  := ClassID;
  1409.   FCategory := Category;
  1410.   FMerit    := Merit;
  1411.   FPinCount := PinCount;
  1412.   FPins     := Pins;
  1413. end;
  1414.  
  1415. constructor TBCClassFactory.CreatePropertyPage(ComClass: TFormPropertyPageClass; const ClassID: TGUID);
  1416. begin
  1417.   Templates.AddObjectFactory(Self);
  1418.   FPropClass := ComClass;
  1419.   FClassID   := ClassID;
  1420. end;
  1421.  
  1422. function TBCClassFactory.CreateInstance(const unkOuter: IUnKnown;
  1423.   const iid: TIID; out obj): HResult;
  1424. var
  1425.   ComObject: TBCUnknown;
  1426.   PropObject: TFormPropertyPage;
  1427. begin
  1428.   if @obj = nil then
  1429.   begin
  1430.     Result := E_POINTER;
  1431.     Exit;
  1432.   end;
  1433.   Pointer(obj) := nil;
  1434.   if FPropClass <> nil then
  1435.     begin
  1436.       PropObject := TFormPropertyPageClass(FPropClass).Create(nil);
  1437.       PropObject.FPropertyPage := TBCBasePropertyPage.Create('',nil, PropObject);
  1438.       Result := PropObject.QueryInterface(IID, obj);
  1439.     end
  1440.   else
  1441.     begin
  1442.       ComObject := TBCUnknownClass(FComClass).CreateFromFactory(self, unkOuter);
  1443.       Result := ComObject.QueryInterface(IID, obj);
  1444.       if ComObject.FRefCount = 0 then ComObject.Free;
  1445.     end;
  1446. end;
  1447.  
  1448. procedure TBCClassFactory.UpdateRegistry(Register: Boolean);
  1449. var
  1450.   FileName: array[0..MAX_PATH-1] of Char;
  1451.   ClassID, ServerKeyName: String;
  1452. begin
  1453.   ClassID := GUIDToString(FClassID);
  1454.   ServerKeyName := 'CLSID\' + ClassID + '\' + 'InprocServer32';
  1455.   if Register then
  1456.   begin
  1457.     CreateRegKey('CLSID\' + ClassID, '', FName);
  1458.     GetModuleFileName(hinstance, FileName, MAX_PATH);
  1459.     CreateRegKey(ServerKeyName, '', FileName);
  1460.     CreateRegKey(ServerKeyName, 'ThreadingModel', 'Both');
  1461.   end else
  1462.   begin
  1463.     DeleteRegKey(ServerKeyName);
  1464.     DeleteRegKey('CLSID\' + ClassID);
  1465.   end;
  1466. end;
  1467.  
  1468. function TBCClassFactory.RegisterFilter(FilterMapper: IFilterMapper; Register: Boolean): boolean;
  1469. type
  1470.   TDynArrayPins = array of TRegFilterPins;
  1471.   TDynArrayPinType = array of TRegPinTypes;
  1472. var
  1473.   i, j: integer;
  1474.   FilterGUID: TGUID;
  1475. begin
  1476.   result := Succeeded(FilterMapper.UnregisterFilter(FClassID));
  1477.   if Register  then
  1478.   begin
  1479.     result := Succeeded(FilterMapper.RegisterFilter(FClassID, StringToOleStr(FName), FMerit));
  1480.     if result then
  1481.     begin
  1482.       for i := 0 to FPinCount - 1 do
  1483.       begin
  1484.         if TDynArrayPins(FPins)[i].oFilter = nil then
  1485.           FilterGUID := GUID_NULL else
  1486.           FilterGUID := TDynArrayPins(FPins)[i].oFilter^;
  1487.         result := Succeeded(FilterMapper.RegisterPin(FClassID,
  1488.           TDynArrayPins(FPins)[i].strName,
  1489.           TDynArrayPins(FPins)[i].bRendered,
  1490.           TDynArrayPins(FPins)[i].bOutput,
  1491.           TDynArrayPins(FPins)[i].bZero,
  1492.           TDynArrayPins(FPins)[i].bMany,
  1493.           FilterGUID,
  1494.           TDynArrayPins(FPins)[i].strConnectsToPin));
  1495.         if result then
  1496.         begin
  1497.           for j := 0 to TDynArrayPins(FPins)[i].nMediaTypes - 1 do
  1498.           begin
  1499.             result := Succeeded(FilterMapper.RegisterPinType(FClassID,
  1500.                         TDynArrayPins(FPins)[i].strName,
  1501.                         TDynArrayPinType(TDynArrayPins(FPins)[i].lpMediaType)[j].clsMajorType^,
  1502.                         TDynArrayPinType(TDynArrayPins(FPins)[i].lpMediaType)[j].clsMinorType^));
  1503.             if not result then break;
  1504.           end;
  1505.           if not result then break;
  1506.         end;
  1507.         if not result then break;
  1508.       end;
  1509.     end;
  1510.   end;
  1511. end;
  1512.  
  1513. function TBCClassFactory.RegisterFilter(FilterMapper: IFilterMapper2; Register: Boolean): boolean;
  1514. var
  1515.   RegFilter: TRegFilter2;
  1516. begin
  1517.   result := Succeeded(FilterMapper.UnregisterFilter(FCategory, nil, FClassID));
  1518.   if Register then
  1519.   begin
  1520.     RegFilter.dwVersion := 1;
  1521.     RegFilter.dwMerit   := FMerit;
  1522.     RegFilter.cPins     := FPinCount;
  1523.     RegFilter.rgPins    := FPins;
  1524.     result := Succeeded(FilterMapper.RegisterFilter(FClassID, PWideChar(WideString(FName)),
  1525.       nil, @FCategory, nil, RegFilter));
  1526.   end;
  1527. end;
  1528.  
  1529. function TBCClassFactory._AddRef: Integer;
  1530. begin
  1531.   result := InterlockedIncrement(FactoryCount);
  1532. end;
  1533.  
  1534. function TBCClassFactory._Release: Integer;
  1535. begin
  1536.   result := InterlockedDecrement(FactoryCount);
  1537. end;
  1538.  
  1539. function TBCClassFactory.LockServer(fLock: BOOL): HResult;
  1540. begin
  1541.   Result := CoLockObjectExternal(Self, fLock, True);
  1542.   if flock then InterlockedIncrement(ObjectCount)
  1543.            else InterlockedDecrement(ObjectCount);
  1544. end;
  1545.  
  1546. function TBCClassFactory.QueryInterface(const IID: TGUID; out Obj): HResult;
  1547. begin
  1548.   if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE;
  1549. end;
  1550.  
  1551. { TBCFilterTemplate }
  1552.  
  1553. procedure TBCFilterTemplate.AddObjectFactory(Factory: TBCClassFactory);
  1554. begin
  1555.   Factory.FNext := FFactoryList;
  1556.   FFactoryList := Factory;
  1557. end;
  1558.  
  1559. constructor TBCFilterTemplate.Create;
  1560. begin
  1561.   FFactoryList := nil;
  1562. end;
  1563.  
  1564. destructor TBCFilterTemplate.Destroy;
  1565. var AFactory: TBCClassFactory;
  1566. begin
  1567.   while FFactoryList <> nil do
  1568.   begin
  1569.     AFactory := FFactoryList;
  1570.     FFactoryList := AFactory.FNext;
  1571.     AFactory.Free;
  1572.   end;
  1573.   inherited Destroy;
  1574. end;
  1575.  
  1576. function TBCFilterTemplate.GetFactoryFromClassID(const CLSID: TGUID): TBCClassFactory;
  1577. var AFactory: TBCClassFactory;
  1578. begin
  1579.   result := nil;
  1580.   AFactory := FFactoryList;
  1581.   while AFactory <> nil do
  1582.   begin
  1583.     if IsEqualGUID(CLSID, AFactory.FClassID) then
  1584.     begin
  1585.       result := AFactory;
  1586.       break;
  1587.     end;
  1588.     AFactory := AFactory.FNext;
  1589.   end;
  1590. end;
  1591.  
  1592. function TBCFilterTemplate.RegisterServer(Register: Boolean): boolean;
  1593.   var
  1594.     Filename: array[0..MAX_PATH-1] of Char;
  1595.     FilterMapper : IFilterMapper;
  1596.     FilterMapper2: IFilterMapper2;
  1597.     Factory: TBCClassFactory;
  1598.   begin
  1599.     result := false;
  1600.     GetModuleFileName(hinstance, Filename, sizeof(Filename));
  1601.     if Failed(CoCreateInstance(CLSID_FilterMapper2, nil, CLSCTX_INPROC_SERVER, IFilterMapper2, FilterMapper2)) then
  1602.     if Failed(CoCreateInstance(CLSID_FilterMapper, nil, CLSCTX_INPROC_SERVER, IFilterMapper, FilterMapper)) then exit;
  1603.  
  1604.     Factory := FFactoryList;
  1605.     while Factory <> nil do
  1606.     begin
  1607.       Factory.UpdateRegistry(false);
  1608.       if FilterMapper2 <> nil then
  1609.            result := Factory.RegisterFilter(FilterMapper2, Register)
  1610.       else result := Factory.RegisterFilter(FilterMapper, Register);
  1611.       if not result then break else Factory.UpdateRegistry(register);
  1612.       Factory := Factory.FNext;
  1613.     end;
  1614.     FilterMapper := nil;
  1615.     FilterMapper2 := nil;
  1616.   end;
  1617.  
  1618. { TBCBaseObject }
  1619.  
  1620. constructor TBCBaseObject.Create(Name: string);
  1621. begin
  1622.   FName := name;
  1623. end;
  1624.  
  1625. procedure TBCBaseObject.FreeInstance;
  1626. begin
  1627.   inherited;
  1628.   InterlockedDecrement(ObjectCount);
  1629. end;
  1630.  
  1631. class function TBCBaseObject.NewInstance: TObject;
  1632. begin
  1633.   result := inherited NewInstance;
  1634.   InterlockedIncrement(ObjectCount);
  1635. end;
  1636.  
  1637. class function TBCBaseObject.ObjectsActive: integer;
  1638. begin
  1639.   result := ObjectCount;
  1640. end;
  1641.  
  1642. { TBCUnknown }
  1643.  
  1644. function TBCUnknown.QueryInterface(const IID: TGUID; out Obj): HResult;
  1645. begin
  1646.   if FOwner <> nil then
  1647.     Result := IUnknown(FOwner).QueryInterface(IID, Obj)
  1648.   else
  1649.     Result := NonDelegatingQueryInterface(IID, Obj);
  1650. end;
  1651.  
  1652. function TBCUnknown._AddRef: Integer;
  1653. begin
  1654.   if FOwner <> nil then
  1655.     Result := IUnknown(FOwner)._AddRef else
  1656.     Result := NonDelegatingAddRef;
  1657. end;
  1658.  
  1659. function TBCUnknown._Release: Integer;
  1660. begin
  1661.   if FOwner <> nil then
  1662.     Result := IUnknown(FOwner)._Release else
  1663.     Result := NonDelegatingRelease;
  1664. end;
  1665.  
  1666. function TBCUnknown.NonDelegatingQueryInterface(const IID: TGUID;
  1667.   out Obj): HResult;
  1668. begin
  1669.   if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE;
  1670. end;
  1671.  
  1672. function TBCUnknown.NonDelegatingAddRef: Integer;
  1673. begin
  1674.   Result := InterlockedIncrement(FRefCount);
  1675. end;
  1676.  
  1677. function TBCUnknown.NonDelegatingRelease: Integer;
  1678. begin
  1679.   Result := InterlockedDecrement(FRefCount);
  1680.   if Result = 0 then Destroy;
  1681. end;
  1682.  
  1683. function TBCUnknown.GetOwner: IUnKnown;
  1684. begin
  1685.   result := IUnKnown(FOwner);
  1686. end;
  1687.  
  1688. constructor TBCUnknown.Create(name: string; Unk: IUnKnown);
  1689. begin
  1690.   inherited Create(name);
  1691.   FOwner := Pointer(Unk);
  1692. end;
  1693.  
  1694. constructor TBCUnknown.CreateFromFactory(Factory: TBCClassFactory;
  1695.   const Controller: IUnKnown);
  1696. begin
  1697.   Create(Factory.FName, Controller);
  1698. end;
  1699.  
  1700. { TBCBaseFilter }
  1701.  
  1702. constructor TBCBaseFilter.Create(Name: string; Unk: IUnKnown;
  1703.   Lock: TBCCritSec; const clsid: TGUID);
  1704. begin
  1705.     inherited Create(Name, Unk);
  1706.     FLock  := Lock;
  1707.     Fclsid := clsid;
  1708.     FState := State_Stopped;
  1709.     FClock := nil;
  1710.     FGraph := nil;
  1711.     FSink  := nil;
  1712.     FFilterName := '';
  1713.     FPinVersion := 1;
  1714.     Assert(FLock <> nil, 'Lock = nil !');
  1715. end;
  1716.  
  1717. constructor TBCBaseFilter.Create(Name: string; Unk: IUnKnown;
  1718.   Lock: TBCCritSec; const clsid: TGUID; out hr: HRESULT);
  1719. begin
  1720.   Create(Name, Unk, Lock, clsid);
  1721.   assert(@hr <> nil, 'Unreferenced parameter: hr');
  1722. end;
  1723.  
  1724. constructor TBCBaseFilter.CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown);
  1725. begin
  1726.   Create(Factory.FName,Controller, TBCCritSec.Create, Factory.FClassID);
  1727. end;
  1728.  
  1729. destructor TBCBaseFilter.destroy;
  1730. begin
  1731.   FFilterName := '';
  1732.   FClock := nil;
  1733.   FLock.Free;
  1734.   inherited;
  1735. end;
  1736.  
  1737. function TBCBaseFilter.EnumPins(out ppEnum: IEnumPins): HRESULT;
  1738. begin
  1739.   // Create a new ref counted enumerator
  1740.   ppEnum := TBCEnumPins.Create(self, nil);
  1741.   if ppEnum = nil then result := E_OUTOFMEMORY else result := NOERROR;
  1742. end;
  1743.  
  1744. function TBCBaseFilter.FindPin(Id: PWideChar; out ppPin: IPin): HRESULT;
  1745. var
  1746.   i: integer;
  1747.   pin: TBCBasePin;
  1748. begin
  1749.   //  We're going to search the pin list so maintain integrity
  1750.   FLock.Lock;
  1751.   try
  1752.     for i := 0 to GetPinCount - 1 do
  1753.     begin
  1754.       Pin := GetPin(i);
  1755.       ASSERT(Pin <> nil);
  1756.       if (Pin.FPinName = WideString(Id)) then
  1757.       begin
  1758.           //  Found one that matches
  1759.           //  AddRef() and return it
  1760.           ppPin := Pin;
  1761.           result := S_OK;
  1762.           exit;
  1763.       end;
  1764.     end;
  1765.     ppPin := nil;
  1766.     result := VFW_E_NOT_FOUND;
  1767.   finally
  1768.     FLock.UnLock;
  1769.   end;
  1770. end;
  1771.  
  1772. function TBCBaseFilter.GetClassID(out classID: TCLSID): HResult;
  1773. begin
  1774.   classID := FCLSID;
  1775.   result  := NOERROR;
  1776. end;
  1777.  
  1778. function TBCBaseFilter.GetFilterGraph: IFilterGraph;
  1779. begin
  1780.   result := FGRaph;
  1781. end;
  1782.  
  1783. function TBCBaseFilter.GetPinVersion: LongInt;
  1784. begin
  1785.   result := FPinVersion;
  1786. end;
  1787.  
  1788. function TBCBaseFilter.GetState(dwMilliSecsTimeout: DWORD;
  1789.   out State: TFilterState): HRESULT;
  1790. begin
  1791.   State := FState;
  1792.   result := S_OK;
  1793. end;
  1794.  
  1795. function TBCBaseFilter.GetSyncSource(out pClock: IReferenceClock): HRESULT;
  1796. begin
  1797.   FLock.Lock;
  1798.   try
  1799.     pClock := FClock;
  1800.   finally
  1801.     result := NOERROR;
  1802.     FLock.UnLock;
  1803.   end;
  1804. end;
  1805.  
  1806. procedure TBCBaseFilter.IncrementPinVersion;
  1807. begin
  1808.   InterlockedIncrement(FPinVersion)
  1809. end;
  1810.  
  1811. function TBCBaseFilter.IsActive: boolean;
  1812. begin
  1813.   FLock.Lock;
  1814.   try
  1815.     result :=  ((FState = State_Paused) or (FState = State_Running));
  1816.   finally
  1817.     FLock.UnLock;
  1818.   end;
  1819. end;
  1820.  
  1821. function TBCBaseFilter.IsStopped: boolean;
  1822. begin
  1823.   result := (FState = State_Stopped);
  1824. end;
  1825.  
  1826. function TBCBaseFilter.JoinFilterGraph(pGraph: IFilterGraph;
  1827.   pName: PWideChar): HRESULT;
  1828. begin
  1829.   FLock.Lock;
  1830.   try
  1831.     //Henri: This implementation seem to be stupid but it's the exact conversion ?????
  1832.     // NOTE: we no longer hold references on the graph (m_pGraph, m_pSink)
  1833.     Pointer(FGraph) := Pointer(pGraph);
  1834.     if (FGraph <> nil) then
  1835.     begin
  1836.       if FAILED(FGraph.QueryInterface(IID_IMediaEventSink, FSink)) then
  1837.            ASSERT(FSink = nil)
  1838.       else FSink := nil;        // we do NOT keep a reference on it.
  1839.     end
  1840.     else
  1841.     begin
  1842.         // if graph pointer is null, then we should
  1843.         // also release the IMediaEventSink on the same object - we don't
  1844.         // refcount it, so just set it to null
  1845.         Pointer(FSink) := nil;
  1846.     end;
  1847.  
  1848.     FFilterName := '';
  1849.     if assigned(pName) then FFilterName := WideString(pName);
  1850.     result := NOERROR;
  1851.   finally
  1852.     FLock.UnLock;
  1853.   end;
  1854. end;
  1855.  
  1856. function TBCBaseFilter.NotifyEvent(EventCode, EventParam1,
  1857.   EventParam2: Integer): HRESULT;
  1858. begin
  1859.   // Snapshot so we don't have to lock up
  1860.   if assigned(FSink) then
  1861.   begin
  1862.     if (EC_COMPLETE = EventCode) then EventParam2 := LongInt(self);
  1863.     result := FSink.Notify(EventCode, EventParam1, EventParam2);
  1864.   end
  1865.   else
  1866.     result := E_NOTIMPL;
  1867. end;
  1868.  
  1869. function TBCBaseFilter.Pause: HRESULT;
  1870. var
  1871.   c: integer;
  1872.   pin: TBCBasePin;
  1873. begin
  1874.   FLock.Lock;
  1875.   try
  1876.     if FState = State_Stopped then
  1877.     begin
  1878.       for c := 0 to GetPinCount - 1 do
  1879.       begin
  1880.         Pin := GetPin(c);
  1881.         // Disconnected pins are not activated - this saves pins
  1882.         // worrying about this state themselves
  1883.         if Pin.IsConnected then
  1884.         begin
  1885.           result := Pin.Active;
  1886.           if FAILED(result) then exit;
  1887.         end;
  1888.       end;
  1889.     end;
  1890.     // notify all pins of the change to active state
  1891.     FState := State_Paused;
  1892.     result := S_OK;
  1893.   finally
  1894.     FLock.UnLock;
  1895.   end;
  1896. end;
  1897.  
  1898. function TBCBaseFilter.QueryFilterInfo(out pInfo: TFilterInfo): HRESULT;
  1899. begin
  1900.   if (FFilterName <> '') then
  1901.     move(Pointer(FFilterName)^, pInfo.achName, length(FFilterName) * 2 + 2)
  1902.   else
  1903.     pInfo.achName[0] := #0;
  1904.   pInfo.pGraph := FGraph;
  1905.   result := NOERROR;
  1906. end;
  1907.  
  1908. function TBCBaseFilter.QueryVendorInfo(out pVendorInfo: PWideChar): HRESULT;
  1909. begin
  1910.   result := E_NOTIMPL;
  1911. end;
  1912.  
  1913. function TBCBaseFilter.ReconnectPin(Pin: IPin; pmt: PAMMediaType): HRESULT;
  1914. var Graph2: IFilterGraph2;
  1915. begin
  1916.   if (FGraph <> nil) then
  1917.     begin
  1918.       result := FGraph.QueryInterface(IID_IFilterGraph2, Graph2);
  1919.       if Succeeded(result) then
  1920.         begin
  1921.           result := Graph2.ReconnectEx(Pin, pmt);
  1922.           Graph2 := nil;
  1923.         end
  1924.       else
  1925.         result := FGraph.Reconnect(Pin);
  1926.     end
  1927.   else
  1928.     result := E_NOINTERFACE;
  1929. end;
  1930.  
  1931. function TBCBaseFilter.Register: HRESULT;
  1932. var
  1933.   Filename: array[0..MAX_PATH-1] of Char;
  1934.   FilterMapper : IFilterMapper;
  1935.   FilterMapper2: IFilterMapper2;
  1936.   Factory: TBCClassFactory;
  1937.   AResult : boolean;
  1938. begin
  1939.   Aresult := false;
  1940.   Result := S_FALSE;
  1941.   Factory := Templates.GetFactoryFromClassID(FCLSID);
  1942.   if Factory <> nil then
  1943.   begin
  1944.     GetModuleFileName(hinstance, Filename, sizeof(Filename));
  1945.     if Failed(CoCreateInstance(CLSID_FilterMapper2, nil, CLSCTX_INPROC_SERVER, IFilterMapper2, FilterMapper2)) then
  1946.     if Failed(CoCreateInstance(CLSID_FilterMapper, nil, CLSCTX_INPROC_SERVER, IFilterMapper, FilterMapper)) then exit;
  1947.     Factory.UpdateRegistry(false);
  1948.     if FilterMapper2 <> nil then
  1949.          AResult := Factory.RegisterFilter(FilterMapper2, true)
  1950.     else AResult := Factory.RegisterFilter(FilterMapper, true);
  1951.     if Aresult then Factory.UpdateRegistry(true);
  1952.     FilterMapper := nil;
  1953.     FilterMapper2 := nil;
  1954.   end;
  1955.   if AResult then result := S_OK else result := S_False;
  1956. end;
  1957.  
  1958. function TBCBaseFilter.Run(tStart: TReferenceTime): HRESULT;
  1959. var
  1960.   c: integer;
  1961.   Pin: TBCBasePin;
  1962. begin
  1963.   FLock.Lock;
  1964.   try
  1965.     // remember the stream time offset
  1966.     FStart := tStart;
  1967.     if FState = State_Stopped then
  1968.     begin
  1969.       result := Pause;
  1970.       if FAILED(result) then exit;
  1971.     end;
  1972.     // notify all pins of the change to active state
  1973.     if (FState <> State_Running) then
  1974.     begin
  1975.       for c := 0 to GetPinCount - 1 do
  1976.       begin
  1977.         Pin := GetPin(c);
  1978.         // Disconnected pins are not activated - this saves pins
  1979.         // worrying about this state themselves
  1980.         if Pin.IsConnected then
  1981.         begin
  1982.           result := Pin.Run(tStart);
  1983.           if FAILED(result) then exit;
  1984.         end;
  1985.       end;
  1986.     end;
  1987.     FState := State_Running;
  1988.     result := S_OK;
  1989.   finally
  1990.     FLock.UnLock;
  1991.   end;
  1992. end;
  1993.  
  1994. function TBCBaseFilter.SetSyncSource(pClock: IReferenceClock): HRESULT;
  1995. begin
  1996.   FLock.Lock;
  1997.   try
  1998.     FClock := pClock;
  1999.   finally
  2000.     result := NOERROR;
  2001.     FLock.UnLock;
  2002.   end;
  2003. end;
  2004.  
  2005. function TBCBaseFilter.Stop: HRESULT;
  2006. var
  2007.   c: integer;
  2008.   Pin: TBCBasePin;
  2009.   hr: HResult;
  2010. begin
  2011.   FLock.Lock;
  2012.   try
  2013.     result := NOERROR;
  2014.     // notify all pins of the state change
  2015.     if (FState <> State_Stopped) then
  2016.     begin
  2017.       for c := 0 to GetPinCount - 1 do
  2018.       begin
  2019.         Pin := GetPin(c);
  2020.         // Disconnected pins are not activated - this saves pins worrying
  2021.         // about this state themselves. We ignore the return code to make
  2022.         // sure everyone is inactivated regardless. The base input pin
  2023.         // class can return an error if it has no allocator but Stop can
  2024.         // be used to resync the graph state after something has gone bad
  2025.         if Pin.IsConnected then
  2026.         begin
  2027.           hr := Pin.Inactive;
  2028.           if (Failed(hr) and SUCCEEDED(result)) then result := hr;
  2029.         end;
  2030.       end;
  2031.     end;
  2032.     FState := State_Stopped;
  2033.   finally
  2034.     FLock.UnLock;
  2035.   end;
  2036. end;
  2037.  
  2038. function TBCBaseFilter.StreamTime(out rtStream: TReferenceTime): HRESULT;
  2039. begin
  2040.   // Caller must lock for synchronization
  2041.   // We can't grab the filter lock because we want to be able to call
  2042.   // this from worker threads without deadlocking
  2043.   if FClock = nil then
  2044.   begin
  2045.     result := VFW_E_NO_CLOCK;
  2046.     exit;
  2047.   end;
  2048.   // get the current reference time
  2049.   result := FClock.GetTime(PInt64(@rtStream)^);
  2050.   if FAILED(result) then exit;
  2051.   // subtract the stream offset to get stream time
  2052.   rtStream := rtStream - FStart;
  2053.   result := S_OK;
  2054. end;
  2055.  
  2056. function TBCBaseFilter.Unregister: HRESULT;
  2057. var
  2058.   Filename: array[0..MAX_PATH-1] of Char;
  2059.   FilterMapper : IFilterMapper;
  2060.   FilterMapper2: IFilterMapper2;
  2061.   Factory: TBCClassFactory;
  2062.   AResult : boolean;
  2063. begin
  2064.   Aresult := false;
  2065.   Result := S_FALSE;
  2066.   Factory := Templates.GetFactoryFromClassID(FCLSID);
  2067.   if Factory <> nil then
  2068.   begin
  2069.     GetModuleFileName(hinstance, Filename, sizeof(Filename));
  2070.     if Failed(CoCreateInstance(CLSID_FilterMapper2, nil, CLSCTX_INPROC_SERVER, IFilterMapper2, FilterMapper2)) then
  2071.     if Failed(CoCreateInstance(CLSID_FilterMapper, nil, CLSCTX_INPROC_SERVER, IFilterMapper, FilterMapper)) then exit;
  2072.     Factory.UpdateRegistry(false);
  2073.     if FilterMapper2 <> nil then
  2074.          AResult := Factory.RegisterFilter(FilterMapper2, false)
  2075.     else AResult := Factory.RegisterFilter(FilterMapper, false);
  2076.     if Aresult then Factory.UpdateRegistry(false);
  2077.     FilterMapper := nil;
  2078.     FilterMapper2 := nil;
  2079.   end;
  2080.   if AResult then result := S_OK else result := S_False;
  2081. end;
  2082.  
  2083. { TBCEnumPins }
  2084.  
  2085. constructor TBCEnumPins.Create(Filter: TBCBaseFilter; EnumPins: TBCEnumPins);
  2086. var i: integer;
  2087. begin
  2088.   FPosition := 0;
  2089.   FPinCount := 0;
  2090.   FFilter   := Filter;
  2091.   FPinCache := TList.Create;
  2092.  
  2093.   // We must be owned by a filter derived from CBaseFilter
  2094.   ASSERT(FFilter <> nil);
  2095.  
  2096.   // Hold a reference count on our filter
  2097.   FFilter._AddRef;
  2098.  
  2099.   // Are we creating a new enumerator
  2100.   if (EnumPins = nil) then
  2101.     begin
  2102.       FVersion  := FFilter.GetPinVersion;
  2103.       FPinCount := FFilter.GetPinCount;
  2104.     end
  2105.   else
  2106.     begin
  2107.       ASSERT(FPosition <= FPinCount);
  2108.       FPosition := EnumPins.FPosition;
  2109.       FPinCount := EnumPins.FPinCount;
  2110.       FVersion  := EnumPins.FVersion;
  2111.       FPinCache.Clear;
  2112.       if EnumPins.FPinCache.Count > 0 then
  2113.         for i := 0 to EnumPins.FPinCache.Count - 1 do
  2114.           FPinCache.Add(EnumPins.FPinCache.Items[i]);
  2115.     end;
  2116. end;
  2117.  
  2118. destructor TBCEnumPins.Destroy;
  2119. begin
  2120.   FPinCache.Free;
  2121.   FFilter._Release;
  2122.   inherited Destroy;
  2123. end;
  2124.  
  2125. function TBCEnumPins.Clone(out ppEnum: IEnumPins): HRESULT;
  2126. begin
  2127.   result := NOERROR;
  2128.   // Check we are still in sync with the filter
  2129.   if AreWeOutOfSync then
  2130.     begin
  2131.       ppEnum := nil;
  2132.       result := VFW_E_ENUM_OUT_OF_SYNC;
  2133.     end
  2134.   else
  2135.   begin
  2136.     ppEnum := TBCEnumPins.Create(FFilter, self);
  2137.     if ppEnum = nil then result := E_OUTOFMEMORY;
  2138.   end;
  2139. end;
  2140.  
  2141. function TBCEnumPins.Next(cPins: ULONG; out ppPins: IPin;
  2142.   pcFetched: PULONG): HRESULT;
  2143. type
  2144.   TPointerDynArray = array of Pointer;
  2145.   TIPinDynArray = array of IPin;
  2146. var
  2147.   Fetched: cardinal;
  2148.   RealPins: integer;
  2149.   Pin: TBCBasePin;
  2150. begin
  2151.     if pcFetched <> nil then
  2152.       pcFetched^ := 0
  2153.     else
  2154.       if (cPins>1) then
  2155.       begin
  2156.         result := E_INVALIDARG;
  2157.         exit;
  2158.       end;
  2159.     Fetched := 0; // increment as we get each one.
  2160.  
  2161.     // Check we are still in sync with the filter
  2162.     // If we are out of sync, we should refresh the enumerator.
  2163.     // This will reset the position and update the other members, but
  2164.     // will not clear cache of pins we have already returned.
  2165.     if AreWeOutOfSync then
  2166.       Refresh;
  2167.  
  2168.     // Calculate the number of available pins
  2169.     RealPins := min(FPinCount - FPosition, cPins);
  2170.     if RealPins = 0 then
  2171.     begin
  2172.       result := S_FALSE;
  2173.       exit;
  2174.     end;
  2175.  
  2176.     {  Return each pin interface NOTE GetPin returns CBasePin * not addrefed
  2177.        so we must QI for the IPin (which increments its reference count)
  2178.        If while we are retrieving a pin from the filter an error occurs we
  2179.        assume that our internal state is stale with respect to the filter
  2180.        (for example someone has deleted a pin) so we
  2181.        return VFW_E_ENUM_OUT_OF_SYNC }
  2182.  
  2183.     while RealPins > 0 do
  2184.     begin
  2185.       // Get the next pin object from the filter */
  2186.       inc(FPosition);
  2187.       Pin := FFilter.GetPin(FPosition-1);
  2188.       if Pin = nil then
  2189.       begin
  2190.         // If this happend, and it's not the first time through, then we've got a problem,
  2191.         // since we should really go back and release the iPins, which we have previously
  2192.         // AddRef'ed.
  2193.         ASSERT(Fetched = 0);
  2194.         result := VFW_E_ENUM_OUT_OF_SYNC;
  2195.         exit;
  2196.       end;
  2197.  
  2198.       // We only want to return this pin, if it is not in our cache
  2199.       if FPinCache.IndexOf(Pin) = -1 then
  2200.       begin
  2201.         // From the object get an IPin interface
  2202.         TPointerDynArray(@ppPins)[Fetched] := nil;
  2203.         TIPinDynArray(@ppPins)[Fetched] := Pin;
  2204.         inc(Fetched);
  2205.         FPinCache.Add(Pin);
  2206.         dec(RealPins);
  2207.       end;
  2208.     end;
  2209.  
  2210.     if (pcFetched <> nil) then pcFetched^ := Fetched;
  2211.  
  2212.     if (cPins = Fetched) then result := NOERROR else result := S_FALSE;
  2213. end;
  2214.  
  2215. function TBCEnumPins.Skip(cPins: ULONG): HRESULT;
  2216. var PinsLeft: Cardinal;
  2217. begin
  2218.   // Check we are still in sync with the filter
  2219.   if AreWeOutOfSync then
  2220.   begin
  2221.     result := VFW_E_ENUM_OUT_OF_SYNC;
  2222.     exit;
  2223.   end;
  2224.  
  2225.   // Work out how many pins are left to skip over
  2226.   // We could position at the end if we are asked to skip too many...
  2227.   // ..which would match the base implementation for CEnumMediaTypes::Skip
  2228.  
  2229.   PinsLeft := FPinCount - FPosition;
  2230.   if (cPins > PinsLeft) then
  2231.   begin
  2232.     result := S_FALSE;
  2233.     exit;
  2234.   end;
  2235.  
  2236.   inc(FPosition, cPins);
  2237.   result := NOERROR;
  2238. end;
  2239.  
  2240. function TBCEnumPins.Reset: HRESULT;
  2241. begin
  2242.   FVersion  := FFilter.GetPinVersion;
  2243.   FPinCount := FFilter.GetPinCount;
  2244.   FPosition := 0;
  2245.   FPinCache.Clear;
  2246.   result := S_OK;
  2247. end;
  2248.  
  2249. function TBCEnumPins.Refresh: HRESULT;
  2250. begin
  2251.   FVersion  := FFilter.GetPinVersion;
  2252.   FPinCount := FFilter.GetPinCount;
  2253.   Fposition := 0;
  2254.   result    := S_OK;
  2255. end;
  2256.  
  2257. function TBCEnumPins.AreWeOutOfSync: boolean;
  2258. begin
  2259.   if FFilter.GetPinVersion = FVersion then result:= FALSE else result := TRUE;
  2260. end;
  2261.  
  2262. { TBCBasePin }
  2263.  
  2264. { Called by IMediaFilter implementation when the state changes from Stopped
  2265.   to either paused or running and in derived classes could do things like
  2266.   commit memory and grab hardware resource (the default is to do nothing) }
  2267.  
  2268. function TBCBasePin.Active: HRESULT;
  2269. begin
  2270.   result := NOERROR;
  2271. end;
  2272.  
  2273. { This is called to make the connection, including the task of finding
  2274.   a media type for the pin connection. pmt is the proposed media type
  2275.   from the Connect call: if this is fully specified, we will try that.
  2276.   Otherwise we enumerate and try all the input pin's types first and
  2277.   if that fails we then enumerate and try all our preferred media types.
  2278.   For each media type we check it against pmt (if non-null and partially
  2279.   specified) as well as checking that both pins will accept it. }
  2280.  
  2281. function TBCBasePin.AgreeMediaType(ReceivePin: IPin; pmt: PAMMediaType): HRESULT;
  2282. var
  2283.   EnumMT: IEnumMediaTypes;
  2284.   hrFailure: HResult;
  2285.   i: integer;
  2286. begin
  2287.   ASSERT(ReceivePin <> nil);
  2288.  
  2289.   // if the media type is fully specified then use that
  2290.   if ((pmt <> nil) and (not TBCMediaType(pmt).IsPartiallySpecified)) then
  2291.   begin
  2292.     // if this media type fails, then we must fail the connection
  2293.     // since if pmt is nonnull we are only allowed to connect
  2294.     // using a type that matches it.
  2295.     result := AttemptConnection(ReceivePin, pmt);
  2296.     exit;
  2297.   end;
  2298.  
  2299.  
  2300.   // Try the other pin's enumerator
  2301.   hrFailure := VFW_E_NO_ACCEPTABLE_TYPES;
  2302.   for i := 0 to 1 do
  2303.   begin
  2304.     if (i = byte(FTryMyTypesFirst)) then
  2305.          result := ReceivePin.EnumMediaTypes(EnumMT)
  2306.     else result := EnumMediaTypes(EnumMT);
  2307.  
  2308.     if Succeeded(Result) then
  2309.     begin
  2310.       Assert(EnumMT <> nil);
  2311.       result := TryMediaTypes(ReceivePin,pmt,EnumMT);
  2312.       EnumMT := nil;
  2313.       if Succeeded(result) then
  2314.         begin
  2315.           result := NOERROR;
  2316.           exit;
  2317.         end
  2318.       else
  2319.         begin
  2320.           // try to remember specific error codes if there are any
  2321.           if ((result <> E_FAIL) and
  2322.               (result <> E_INVALIDARG) and
  2323.               (result <> VFW_E_TYPE_NOT_ACCEPTED)) then hrFailure := result;
  2324.         end;
  2325.     end;
  2326.   end;
  2327.   result := hrFailure;
  2328. end;
  2329.  
  2330. function TBCBasePin.AttemptConnection(ReceivePin: IPin; pmt: PAMMediaType): HRESULT;
  2331. begin
  2332.  
  2333.   // The caller should hold the filter lock becasue this function
  2334.   // uses m_Connected.  The caller should also hold the filter lock
  2335.   // because this function calls SetMediaType(), IsStopped() and
  2336.   // CompleteConnect().
  2337.   ASSERT(FLock.CritCheckIn);
  2338.  
  2339.   // Check that the connection is valid  -- need to do this for every
  2340.   // connect attempt since BreakConnect will undo it.
  2341.   result := CheckConnect(ReceivePin);
  2342.   if FAILED(result) then
  2343.   begin
  2344.     DbgLog(self, 'CheckConnect failed');
  2345.     // Since the procedure is already returning an error code, there
  2346.     // is nothing else this function can do to report the error.
  2347.     Assert(SUCCEEDED(BreakConnect));
  2348.     exit;
  2349.   end;
  2350.  
  2351.   DisplayTypeInfo(ReceivePin, pmt);
  2352.  
  2353.   // Check we will accept this media type
  2354.  
  2355.   result := CheckMediaType(pmt);
  2356.   if (result = NOERROR) then
  2357.     begin
  2358.       // Make ourselves look connected otherwise ReceiveConnection
  2359.       // may not be able to complete the connection
  2360.       FConnected := ReceivePin;
  2361.       result := SetMediaType(pmt);
  2362.       if Succeeded(result) then
  2363.       begin
  2364.         // See if the other pin will accept this type */
  2365.         result := ReceivePin.ReceiveConnection(self, pmt^);
  2366.         if Succeeded(result) then
  2367.         begin
  2368.           // Complete the connection
  2369.           result := CompleteConnect(ReceivePin);
  2370.           if Succeeded(result) then exit
  2371.           else
  2372.             begin
  2373.               DbgLog(self, 'Failed to complete connection');
  2374.               ReceivePin.Disconnect;
  2375.             end;
  2376.         end;
  2377.       end;
  2378.     end
  2379.   else
  2380.     begin
  2381.       // we cannot use this media type
  2382.       // return a specific media type error if there is one
  2383.       // or map a general failure code to something more helpful
  2384.       // (in particular S_FALSE gets changed to an error code)
  2385.       if (SUCCEEDED(result) or (result = E_FAIL) or (result = E_INVALIDARG)) then
  2386.         result := VFW_E_TYPE_NOT_ACCEPTED;
  2387.     end;
  2388.  
  2389.   // BreakConnect and release any connection here in case CheckMediaType
  2390.   // failed, or if we set anything up during a call back during
  2391.   // ReceiveConnection.
  2392.  
  2393.   // Since the procedure is already returning an error code, there
  2394.   // is nothing else this function can do to report the error.
  2395.   Assert(Succeeded(BreakConnect));
  2396.  
  2397.   //  If failed then undo our state
  2398.   FConnected := nil;
  2399. end;
  2400.  
  2401. { This is called when we realise we can't make a connection to the pin and
  2402.   must undo anything we did in CheckConnect - override to release QIs done }
  2403.  
  2404. function TBCBasePin.BreakConnect: HRESULT;
  2405. begin
  2406.   result := NOERROR;
  2407. end;
  2408.  
  2409. { This is called during Connect() to provide a virtual method that can do
  2410.   any specific check needed for connection such as QueryInterface. This
  2411.   base class method just checks that the pin directions don't match }
  2412.  
  2413. function TBCBasePin.CheckConnect(Pin: IPin): HRESULT;
  2414. var pd: TPinDirection;
  2415. begin
  2416.   // Check that pin directions DONT match
  2417.   Pin.QueryDirection(pd);
  2418.   ASSERT((pd = PINDIR_OUTPUT) or (pd = PINDIR_INPUT));
  2419.   ASSERT((Fdir = PINDIR_OUTPUT) or (Fdir = PINDIR_INPUT));
  2420.  
  2421.   // we should allow for non-input and non-output connections?
  2422.   if (pd = Fdir) then result := VFW_E_INVALID_DIRECTION
  2423.                  else result := NOERROR;
  2424. end;
  2425.  
  2426. { Called when we want to complete a connection to another filter. Failing
  2427.   this will also fail the connection and disconnect the other pin as well }
  2428.  
  2429. function TBCBasePin.CompleteConnect(ReceivePin: IPin): HRESULT;
  2430. begin
  2431.   result := NOERROR;
  2432. end;
  2433.  
  2434.  { Asked to connect to a pin. A pin is always attached to an owning filter
  2435.    object so we always delegate our locking to that object. We first of all
  2436.    retrieve a media type enumerator for the input pin and see if we accept
  2437.    any of the formats that it would ideally like, failing that we retrieve
  2438.    our enumerator and see if it will accept any of our preferred types }
  2439.  
  2440. function TBCBasePin.Connect(pReceivePin: IPin; const pmt: PAMMediaType): HRESULT;
  2441. var HR: HResult;
  2442. begin
  2443.   FLock.Lock;
  2444.   try
  2445.     DisplayPinInfo(pReceivePin);
  2446.     // See if we are already connected
  2447.     if FConnected <> nil then
  2448.     begin
  2449.       DbgLog(self, 'Already connected');
  2450.       result := VFW_E_ALREADY_CONNECTED;
  2451.     end;
  2452.  
  2453.     // See if the filter is active
  2454.     if (not IsStopped) and (not FCanReconnectWhenActive) then
  2455.     begin
  2456.       result := VFW_E_NOT_STOPPED;
  2457.       exit;
  2458.     end;
  2459.  
  2460.     // Find a mutually agreeable media type -
  2461.     // Pass in the template media type. If this is partially specified,
  2462.     // each of the enumerated media types will need to be checked against
  2463.     // it. If it is non-null and fully specified, we will just try to connect
  2464.     // with this.
  2465.     Hr := AgreeMediaType(pReceivePin, pmt);
  2466.     if Failed(hr) then
  2467.     begin
  2468.       DbgLog(self, 'Failed to agree type');
  2469.       // Since the procedure is already returning an error code, there
  2470.       // is nothing else this function can do to report the error.
  2471.       ASSERT(SUCCEEDED(BreakConnect));
  2472.       result := HR;
  2473.       exit;
  2474.     end;
  2475.     DbgLog(self, 'Connection succeeded');
  2476.     result := NOERROR;
  2477.   finally
  2478.     FLock.UnLock;
  2479.   end;
  2480. end;
  2481.  
  2482. // Return an AddRef()'d pointer to the connected pin if there is one
  2483.  
  2484. function TBCBasePin.ConnectedTo(out pPin: IPin): HRESULT;
  2485. begin
  2486.     //  It's pointless to lock here.
  2487.     //  The caller should ensure integrity.
  2488.     pPin := FConnected;
  2489.     if (pPin <> nil) then
  2490.          result := S_OK
  2491.     else result := VFW_E_NOT_CONNECTED;
  2492. end;
  2493.  
  2494. function TBCBasePin.ConnectionMediaType(out pmt: TAMMediaType): HRESULT;
  2495. begin
  2496.   FLock.Lock;
  2497.   try
  2498.     //  Copy constructor of m_mt allocates the memory
  2499.     if IsConnected then
  2500.       begin
  2501.         CopyMediaType(@pmt,@Fmt);
  2502.         result := S_OK;
  2503.       end
  2504.     else
  2505.       begin
  2506.         zeromemory(@pmt, SizeOf(TAMMediaType));
  2507.         pmt.lSampleSize := 1;
  2508.         pmt.bFixedSizeSamples := true;
  2509.         result := VFW_E_NOT_CONNECTED;
  2510.       end;
  2511.   finally
  2512.  
  2513.     FLock.UnLock;
  2514.   end;
  2515. end;
  2516.  
  2517. constructor TBCBasePin.Create(ObjectName: string; Filter: TBCBaseFilter;
  2518.   Lock: TBCCritSec; out hr: HRESULT; Name: WideString;
  2519.   dir: TPinDirection);
  2520. begin
  2521.   inherited Create(ObjectName, nil);
  2522.   FFilter                 := Filter;
  2523.   FLock                   := Lock;
  2524.   FPinName                := Name;
  2525.   FConnected              := nil;
  2526.   Fdir                    := dir;
  2527.   FRunTimeError           := FALSE;
  2528.   FQSink                  := nil;
  2529.   FTypeVersion            := 1;
  2530.   FStart                  := 0;
  2531.   FStop                   := MAX_TIME;
  2532.   FCanReconnectWhenActive := false;
  2533.   FTryMyTypesFirst        := false;
  2534.   FRate                   := 1.0;
  2535.   { WARNING - Filter is often not a properly constituted object at
  2536.     this state (in particular QueryInterface may not work) - this
  2537.     is because its owner is often its containing object and we
  2538.     have been called from the containing object's constructor so
  2539.     the filter's owner has not yet had its CUnknown constructor
  2540.     called.}
  2541.  
  2542.   FRef := 0; // debug
  2543.   ZeroMemory(@fmt, SizeOf(TAMMediaType));
  2544.   ASSERT(Filter <> nil);
  2545.   ASSERT(Lock <> nil);
  2546. end;
  2547.  
  2548. destructor TBCBasePin.destroy;
  2549. begin
  2550.   //  We don't call disconnect because if the filter is going away
  2551.   //  all the pins must have a reference count of zero so they must
  2552.   //  have been disconnected anyway - (but check the assumption)
  2553.   ASSERT(FConnected = nil);
  2554.   FPinName := '';
  2555.   Assert(FRef = 0);
  2556.   FreeMediaType(@fmt);
  2557.   inherited Destroy;
  2558. end;
  2559.  
  2560. // Called when we want to terminate a pin connection
  2561.  
  2562. function TBCBasePin.Disconnect: HRESULT;
  2563. begin
  2564.   FLock.Lock;
  2565.   try
  2566.     // See if the filter is active
  2567.     if not IsStopped then
  2568.          result := VFW_E_NOT_STOPPED
  2569.     else result := DisconnectInternal;
  2570.   finally
  2571.     FLock.UnLock;
  2572.   end;
  2573. end;
  2574.  
  2575. function TBCBasePin.DisconnectInternal: HRESULT;
  2576. begin
  2577.   ASSERT(FLock.CritCheckIn);
  2578.   if (FConnected <> nil) then
  2579.     begin
  2580.       result := BreakConnect;
  2581.       if FAILED(result) then
  2582.       begin
  2583.         // There is usually a bug in the program if BreakConnect() fails.
  2584.         DbgLog(self, 'WARNING: BreakConnect() failed in CBasePin::Disconnect().');
  2585.         exit;
  2586.       end;
  2587.       FConnected := nil;
  2588.       result := S_OK;
  2589.       exit;
  2590.     end
  2591.   else
  2592.     // no connection - not an error
  2593.     result := S_FALSE;
  2594. end;
  2595.  
  2596. procedure TBCBasePin.DisplayPinInfo(ReceivePin: IPin);
  2597. {$IFDEF DEBUG}
  2598. const
  2599.   BadPin : WideString = 'Bad Pin';
  2600. var
  2601.   ConnectPinInfo, ReceivePinInfo: TPinInfo;
  2602. begin
  2603.   if FAILED(QueryPinInfo(ConnectPinInfo)) then
  2604.        move(Pointer(BadPin)^, ConnectPinInfo.achName, length(BadPin) * 2 +2)
  2605.   else ConnectPinInfo.pFilter := nil;
  2606.   if FAILED(ReceivePin.QueryPinInfo(ReceivePinInfo)) then
  2607.         move(Pointer(BadPin)^, ReceivePinInfo.achName, length(BadPin) * 2 +2)
  2608.    else ReceivePinInfo.pFilter := nil;
  2609.   DbgLog(self, 'Trying to connect Pins :');
  2610.   DbgLog(self, format('    <%s>', [ConnectPinInfo.achName]));
  2611.   DbgLog(self, format('    <%s>', [ReceivePinInfo.achName]));
  2612. {$ELSE}
  2613. begin
  2614. {$ENDIF}
  2615. end;
  2616.  
  2617. procedure TBCBasePin.DisplayTypeInfo(Pin: IPin; pmt: PAMMediaType);
  2618. begin
  2619. {$IFDEF DEBUG}
  2620.   DbgLog(self, 'Trying media type:');
  2621.   DbgLog(self, '    major type:  '+ GuidToString(pmt.majortype));
  2622.   DbgLog(self, '    sub type  :  '+ GuidToString(pmt.subtype));
  2623.   DbgLog(self, GetMediaTypeDescription(pmt^));  
  2624.   {$ENDIF}
  2625.  
  2626. end;
  2627.  
  2628. // Called when no more data will arrive
  2629.  
  2630. function TBCBasePin.EndOfStream: HRESULT;
  2631. begin
  2632.   result := S_OK;
  2633. end;
  2634.  
  2635. { This can be called to return an enumerator for the pin's list of preferred
  2636.   media types. An input pin is not obliged to have any preferred formats
  2637.   although it can do. For example, the window renderer has a preferred type
  2638.   which describes a video image that matches the current window size. All
  2639.   output pins should expose at least one preferred format otherwise it is
  2640.   possible that neither pin has any types and so no connection is possible }
  2641.  
  2642. function TBCBasePin.EnumMediaTypes(out ppEnum: IEnumMediaTypes): HRESULT;
  2643. begin
  2644.   // Create a new ref counted enumerator
  2645.   ppEnum := TBCEnumMediaTypes.Create(self, nil);
  2646.   if (ppEnum = nil) then result := E_OUTOFMEMORY
  2647.                     else result := NOERROR;
  2648. end;
  2649.  
  2650.  
  2651. { This is a virtual function that returns a media type corresponding with
  2652.   place iPosition in the list. This base class simply returns an error as
  2653.   we support no media types by default but derived classes should override }
  2654.  
  2655. function TBCBasePin.GetMediaType(Position: integer;
  2656.   out MediaType: PAMMediaType): HRESULT;
  2657. begin
  2658.   result := E_UNEXPECTED;;
  2659. end;
  2660.  
  2661.  
  2662. { This is a virtual function that returns the current media type version.
  2663.   The base class initialises the media type enumerators with the value 1
  2664.   By default we always returns that same value. A Derived class may change
  2665.   the list of media types available and after doing so it should increment
  2666.   the version either in a method derived from this, or more simply by just
  2667.   incrementing the m_TypeVersion base pin variable. The type enumerators
  2668.   call this when they want to see if their enumerations are out of date }
  2669.  
  2670. function TBCBasePin.GetMediaTypeVersion: longint;
  2671. begin
  2672.   result := FTypeVersion;
  2673. end;
  2674.  
  2675. { Also called by the IMediaFilter implementation when the state changes to
  2676.   Stopped at which point you should decommit allocators and free hardware
  2677.   resources you grabbed in the Active call (default is also to do nothing) }
  2678.  
  2679. function TBCBasePin.Inactive: HRESULT;
  2680. begin
  2681.   FRunTimeError := FALSE;
  2682.   result := NOERROR;
  2683. end;
  2684.  
  2685. // Increment the cookie representing the current media type version
  2686.  
  2687. procedure TBCBasePin.IncrementTypeVersion;
  2688. begin
  2689.   InterlockedIncrement(FTypeVersion);
  2690. end;
  2691.  
  2692. function TBCBasePin.IsConnected: boolean;
  2693. begin
  2694.   result := FConnected <> nil;
  2695. end;
  2696.  
  2697. function TBCBasePin.IsStopped: boolean;
  2698. begin
  2699.   result := FFilter.FState = State_Stopped;
  2700. end;
  2701.  
  2702. // NewSegment notifies of the start/stop/rate applying to the data
  2703. // about to be received. Default implementation records data and
  2704. // returns S_OK.
  2705. // Override this to pass downstream.
  2706.  
  2707. function TBCBasePin.NewSegment(tStart, tStop: TReferenceTime;
  2708.   dRate: double): HRESULT;
  2709. begin
  2710.   FStart := tStart;
  2711.   FStop  := tStop;
  2712.   FRate  := dRate;
  2713.   result := S_OK;
  2714. end;
  2715.  
  2716. function TBCBasePin.NonDelegatingAddRef: Integer;
  2717. begin
  2718.   ASSERT(InterlockedIncrement(FRef) > 0);
  2719.   result := FFilter._AddRef;
  2720. end;
  2721.  
  2722. function TBCBasePin.NonDelegatingRelease: Integer;
  2723. begin
  2724.   ASSERT(InterlockedDecrement(FRef) >= 0);
  2725.   result := FFilter._Release
  2726. end;
  2727.  
  2728. function TBCBasePin.Notify(pSelf: IBaseFilter; q: TQuality): HRESULT;
  2729. begin
  2730.     DbgLog(self, 'IQualityControl::Notify not over-ridden from CBasePin.  (IGNORE is OK)');
  2731.     result := E_NOTIMPL;
  2732. end;
  2733.  
  2734. { Does this pin support this media type WARNING this interface function does
  2735.   not lock the main object as it is meant to be asynchronous by nature - if
  2736.   the media types you support depend on some internal state that is updated
  2737.   dynamically then you will need to implement locking in a derived class }
  2738.  
  2739. function TBCBasePin.QueryAccept(const pmt: TAMMediaType): HRESULT;
  2740. begin
  2741.   { The CheckMediaType method is valid to return error codes if the media
  2742.     type is horrible, an example might be E_INVALIDARG. What we do here
  2743.     is map all the error codes into either S_OK or S_FALSE regardless }
  2744.   result := CheckMediaType(@pmt);
  2745.   if FAILED(result) then result := S_FALSE;
  2746. end;
  2747.  
  2748. function TBCBasePin.QueryDirection(out pPinDir: TPinDirection): HRESULT;
  2749. begin
  2750.   pPinDir := Fdir;
  2751.   result  := NOERROR;
  2752. end;
  2753.  
  2754. function TBCBasePin.QueryId(out Id: PWideChar): HRESULT;
  2755. begin
  2756.   result := AMGetWideString(FPinName, id);
  2757. end;
  2758.  
  2759. function TBCBasePin.QueryInternalConnections(out apPin: IPin;
  2760.   var nPin: ULONG): HRESULT;
  2761. begin
  2762.   result := E_NOTIMPL;
  2763. end;
  2764.  
  2765. // Return information about the filter we are connect to
  2766.  
  2767. function TBCBasePin.QueryPinInfo(out pInfo: TPinInfo): HRESULT;
  2768. begin
  2769.   pInfo.pFilter := FFilter;
  2770.   if (FPinName <> '') then
  2771.     begin
  2772.        move(Pointer(FPinName)^, pInfo.achName, length(FPinName)*2);
  2773.        pInfo.achName[length(FPinName)] := #0;
  2774.     end
  2775.   else pInfo.achName[0] := #0;
  2776.   pInfo.dir := Fdir;
  2777.   result := NOERROR;
  2778. end;
  2779.  
  2780. { Called normally by an output pin on an input pin to try and establish a
  2781.   connection. }
  2782.  
  2783. function TBCBasePin.ReceiveConnection(pConnector: IPin;
  2784.   const pmt: TAMMediaType): HRESULT;
  2785. begin
  2786.   FLock.Lock;
  2787.   try
  2788.     // Are we already connected
  2789.     if (FConnected <> nil) then
  2790.     begin
  2791.       result := VFW_E_ALREADY_CONNECTED;
  2792.       exit;
  2793.     end;
  2794.  
  2795.     // See if the filter is active
  2796.     if (not IsStopped) and (not FCanReconnectWhenActive) then
  2797.     begin
  2798.       result := VFW_E_NOT_STOPPED;
  2799.       exit;
  2800.     end;
  2801.  
  2802.     result := CheckConnect(pConnector);
  2803.     if FAILED(result) then
  2804.     begin
  2805.       // Since the procedure is already returning an error code, there
  2806.       // is nothing else this function can do to report the error.
  2807.       ASSERT(SUCCEEDED(BreakConnect));
  2808.       exit;
  2809.     end;
  2810.  
  2811.     // Ask derived class if this media type is ok
  2812.  
  2813.     //CMediaType * pcmt = (CMediaType*) pmt;
  2814.     result := CheckMediaType(@pmt);
  2815.     if (result <> NOERROR) then
  2816.     begin
  2817.       // no -we don't support this media type
  2818.       // Since the procedure is already returning an error code, there
  2819.       // is nothing else this function can do to report the error.
  2820.       ASSERT(SUCCEEDED(BreakConnect));
  2821.       // return a specific media type error if there is one
  2822.       // or map a general failure code to something more helpful
  2823.       // (in particular S_FALSE gets changed to an error code)
  2824.       if (SUCCEEDED(result) or
  2825.           (result = E_FAIL) or
  2826.           (result = E_INVALIDARG)) then
  2827.         result := VFW_E_TYPE_NOT_ACCEPTED;
  2828.       exit;
  2829.     end;
  2830.  
  2831.     // Complete the connection
  2832.     FConnected := pConnector;
  2833.     result := SetMediaType(@pmt);
  2834.     if SUCCEEDED(result) then
  2835.     begin
  2836.       result := CompleteConnect(pConnector);
  2837.       if SUCCEEDED(result) then
  2838.       begin
  2839.         result := S_OK;
  2840.         exit;
  2841.       end;
  2842.     end;
  2843.  
  2844.     DbgLog(self, 'Failed to set the media type or failed to complete the connection.');
  2845.     FConnected := nil;
  2846.  
  2847.     // Since the procedure is already returning an error code, there
  2848.     // is nothing else this function can do to report the error.
  2849.     ASSERT(SUCCEEDED(BreakConnect));
  2850.   finally
  2851.     FLock.UnLock;
  2852.   end;
  2853. end;
  2854.  
  2855. { Called by IMediaFilter implementation when the state changes from
  2856.   to either paused to running and in derived classes could do things like
  2857.   commit memory and grab hardware resource (the default is to do nothing) }
  2858.  
  2859. function TBCBasePin.Run(Start: TReferenceTime): HRESULT;
  2860. begin
  2861.   result := NOERROR;
  2862. end;
  2863.  
  2864.  
  2865. function TBCBasePin.GetCurrentMediaType: TBCMediaType;
  2866. begin
  2867.   result := TBCMediaType(@FMT);
  2868. end;
  2869.  
  2870. function TBCBasePin.GetAMMediaType: PAMMediaType;
  2871. begin
  2872.   result := @FMT;
  2873. end;
  2874.  
  2875. { This is called to set the format for a pin connection - CheckMediaType
  2876.   will have been called to check the connection format and if it didn't
  2877.   return an error code then this (virtual) function will be invoked }
  2878.  
  2879. function TBCBasePin.SetMediaType(mt: PAMMediaType): HRESULT;
  2880. begin
  2881.   FreeMediaType(@Fmt);
  2882.   CopyMediaType(@Fmt, mt);
  2883.   result := NOERROR;
  2884. end;
  2885.  
  2886. function TBCBasePin.SetSink(piqc: IQualityControl): HRESULT;
  2887. begin
  2888.   FLock.Lock;
  2889.   try
  2890.     FQSink := piqc;
  2891.     result := NOERROR;
  2892.   finally
  2893.     FLock.UnLock;
  2894.   end;
  2895. end;
  2896.  
  2897. { Given an enumerator we cycle through all the media types it proposes and
  2898.   firstly suggest them to our derived pin class and if that succeeds try
  2899.   them with the pin in a ReceiveConnection call. This means that if our pin
  2900.   proposes a media type we still check in here that we can support it. This
  2901.   is deliberate so that in simple cases the enumerator can hold all of the
  2902.   media types even if some of them are not really currently available }
  2903.  
  2904. function TBCBasePin.TryMediaTypes(ReceivePin: IPin; pmt: PAMMediaType;
  2905.   Enum: IEnumMediaTypes): HRESULT;
  2906. var
  2907.   MediaCount: Cardinal;
  2908.   hrFailure : HResult;
  2909.   MediaType : PAMMediaType;
  2910. begin
  2911.   // Reset the current enumerator position
  2912.   result := Enum.Reset;
  2913.   if Failed(result) then exit;
  2914.  
  2915.   MediaCount := 0;
  2916.  
  2917.   // attempt to remember a specific error code if there is one
  2918.   hrFailure := S_OK;
  2919.  
  2920.   while true do
  2921.   begin
  2922.     { Retrieve the next media type NOTE each time round the loop the
  2923.       enumerator interface will allocate another AM_MEDIA_TYPE structure
  2924.       If we are successful then we copy it into our output object, if
  2925.       not then we must delete the memory allocated before returning }
  2926.  
  2927.     result := Enum.Next(1, MediaType, @MediaCount);
  2928.     if (result <> S_OK) then
  2929.     begin
  2930.       if (S_OK = hrFailure) then
  2931.         hrFailure := VFW_E_NO_ACCEPTABLE_TYPES;
  2932.       result := hrFailure;
  2933.       exit;
  2934.     end;
  2935.  
  2936.     ASSERT(MediaCount = 1);
  2937.     ASSERT(MediaType <> nil);
  2938.     // check that this matches the partial type (if any)
  2939.  
  2940.     if (pmt = nil) or TBCMediaType(MediaType).MatchesPartial(pmt) then
  2941.     begin
  2942.       result := AttemptConnection(ReceivePin, MediaType);
  2943.       // attempt to remember a specific error code
  2944.       if FAILED(result)           and
  2945.          SUCCEEDED(hrFailure)     and
  2946.          (result <> E_FAIL)       and
  2947.          (result <> E_INVALIDARG) and
  2948.          (result <> VFW_E_TYPE_NOT_ACCEPTED) then hrFailure := result;
  2949.     end
  2950.     else result := VFW_E_NO_ACCEPTABLE_TYPES;
  2951.     DeleteMediaType(MediaType);
  2952.     if result = S_OK then exit;
  2953.   end;
  2954. end;
  2955.  
  2956. { TBCEnumMediaTypes }
  2957.  
  2958. { The media types a filter supports can be quite dynamic so we add to
  2959.   the general IEnumXXXX interface the ability to be signaled when they
  2960.   change via an event handle the connected filter supplies. Until the
  2961.   Reset method is called after the state changes all further calls to
  2962.   the enumerator (except Reset) will return E_UNEXPECTED error code. }
  2963.  
  2964. function TBCEnumMediaTypes.AreWeOutOfSync: boolean;
  2965. begin
  2966.   if FPin.GetMediaTypeVersion = FVersion then result := FALSE else result := TRUE;
  2967. end;
  2968.  
  2969. { One of an enumerator's basic member functions allows us to create a cloned
  2970.   interface that initially has the same state. Since we are taking a snapshot
  2971.   of an object (current position and all) we must lock access at the start }
  2972.  
  2973. function TBCEnumMediaTypes.Clone(out ppEnum: IEnumMediaTypes): HRESULT;
  2974. begin
  2975.   result := NOERROR;
  2976.   // Check we are still in sync with the pin
  2977.   if AreWeOutOfSync then
  2978.     begin
  2979.       ppEnum := nil;
  2980.       result := VFW_E_ENUM_OUT_OF_SYNC;
  2981.       exit;
  2982.     end
  2983.   else
  2984.     begin
  2985.       ppEnum := TBCEnumMediaTypes.Create(FPin, self);
  2986.       if (ppEnum = nil) then result := E_OUTOFMEMORY;
  2987.     end;
  2988. end;
  2989.  
  2990. constructor TBCEnumMediaTypes.Create(Pin: TBCBasePin;
  2991.   EnumMediaTypes: TBCEnumMediaTypes);
  2992. begin
  2993.   FPosition := 0;
  2994.   FPin      := Pin;
  2995.   {$IFDEF DEBUG}
  2996.     DbgLog(nil, 'TBCEnumMediaTypes.Create');
  2997.   {$ENDIF}
  2998.  
  2999.   // We must be owned by a pin derived from CBasePin */
  3000.   ASSERT(Pin <> nil);
  3001.  
  3002.   // Hold a reference count on our pin
  3003.   FPin._AddRef;
  3004.  
  3005.   // Are we creating a new enumerator
  3006.  
  3007.   if (EnumMediaTypes = nil) then
  3008.   begin
  3009.     FVersion := FPin.GetMediaTypeVersion;
  3010.     exit;
  3011.   end;
  3012.  
  3013.   FPosition := EnumMediaTypes.FPosition;
  3014.   FVersion  := EnumMediaTypes.FVersion;
  3015. end;
  3016.  
  3017. { Destructor releases the reference count on our base pin. NOTE since we hold
  3018.   a reference count on the pin who created us we know it is safe to release
  3019.   it, no access can be made to it afterwards though as we might have just
  3020.   caused the last reference count to go and the object to be deleted }
  3021.  
  3022. destructor TBCEnumMediaTypes.Destroy;
  3023. begin
  3024.   {$IFDEF DEBUG}
  3025.     DbgLog(nil, 'TBCEnumMediaTypes.Destroy');
  3026.   {$ENDIF}
  3027.   FPin._Release;
  3028.   inherited;
  3029. end;
  3030.  
  3031. { Enumerate the next pin(s) after the current position. The client using this
  3032.    interface passes in a pointer to an array of pointers each of which will
  3033.    be filled in with a pointer to a fully initialised media type format
  3034.    Return NOERROR if it all works,
  3035.           S_FALSE if fewer than cMediaTypes were enumerated.
  3036.           VFW_E_ENUM_OUT_OF_SYNC if the enumerator has been broken by
  3037.                                  state changes in the filter
  3038.    The actual count always correctly reflects the number of types in the array.}
  3039.  
  3040. function TBCEnumMediaTypes.Next(cMediaTypes: ULONG;
  3041.   out ppMediaTypes: PAMMediaType; pcFetched: PULONG): HRESULT;
  3042. type TMTDynArray = array of PAMMediaType;
  3043. var
  3044.   Fetched: Cardinal;
  3045.   cmt: PAMMediaType;
  3046. begin
  3047.     // Check we are still in sync with the pin
  3048.     if AreWeOutOfSync then
  3049.       begin
  3050.         result := VFW_E_ENUM_OUT_OF_SYNC;
  3051.         exit;
  3052.       end;
  3053.  
  3054.     if (pcFetched <> nil) then
  3055.       pcFetched^ := 0           // default unless we succeed
  3056.     // now check that the parameter is valid
  3057.     else
  3058.       if (cMediaTypes > 1) then
  3059.         begin     // pcFetched == NULL
  3060.           result := E_INVALIDARG;
  3061.           exit;
  3062.         end;
  3063.  
  3064.     Fetched := 0;           // increment as we get each one.
  3065.  
  3066.     {  Return each media type by asking the filter for them in turn - If we
  3067.        have an error code retured to us while we are retrieving a media type
  3068.        we assume that our internal state is stale with respect to the filter
  3069.        (for example the window size changing) so we return
  3070.        VFW_E_ENUM_OUT_OF_SYNC }
  3071.  
  3072.     new(cmt);
  3073.     while (cMediaTypes > 0) do
  3074.     begin
  3075.         TBCMediaType(cmt).InitMediaType;
  3076.         inc(FPosition);
  3077.         result := FPin.GetMediaType(FPosition-1, cmt);
  3078.         if (S_OK <> result) then Break;
  3079.  
  3080.         {  We now have a CMediaType object that contains the next media type
  3081.            but when we assign it to the array position we CANNOT just assign
  3082.            the AM_MEDIA_TYPE structure because as soon as the object goes out of
  3083.            scope it will delete the memory we have just copied. The function
  3084.            we use is CreateMediaType which allocates a task memory block }
  3085.  
  3086.         {   Transfer across the format block manually to save an allocate
  3087.             and free on the format block and generally go faster }
  3088.  
  3089.         TMTDynArray(@ppMediaTypes)[Fetched] := CoTaskMemAlloc(sizeof(TAMMediaType));
  3090.         if TMTDynArray(@ppMediaTypes)[Fetched] = nil then Break;
  3091.  
  3092.         {  Do a regular copy }
  3093.         //CopyMediaType(TMTDynArray(@ppMediaTypes)[Fetched], cmt);
  3094.         Move(cmt^,TMTDynArray(@ppMediaTypes)[Fetched]^,SizeOf(TAMMediaType));
  3095.  
  3096.         // Make sure the destructor doesn't free these
  3097.         cmt.pbFormat      := nil;
  3098.         cmt.cbFormat      := 0;
  3099.         Pointer(cmt.pUnk) := nil;
  3100.  
  3101.         inc(Fetched);
  3102.         dec(cMediaTypes);
  3103.     end;
  3104.     dispose(cmt);
  3105.     if (pcFetched <> nil) then pcFetched^ := Fetched;
  3106.     if cMediaTypes = 0 then result := NOERROR else result := S_FALSE;
  3107. end;
  3108.  
  3109. { Set the current position back to the start
  3110.   Reset has 3 simple steps:
  3111.   set position to head of list
  3112.   sync enumerator with object being enumerated
  3113.   return S_OK }
  3114.  
  3115. function TBCEnumMediaTypes.Reset: HRESULT;
  3116. begin
  3117.   FPosition := 0;
  3118.   // Bring the enumerator back into step with the current state.  This
  3119.   // may be a noop but ensures that the enumerator will be valid on the
  3120.   // next call.
  3121.   FVersion := FPin.GetMediaTypeVersion;
  3122.   result := NOERROR;
  3123. end;
  3124.  
  3125. // Skip over one or more entries in the enumerator
  3126.  
  3127. function TBCEnumMediaTypes.Skip(cMediaTypes: ULONG): HRESULT;
  3128. var cmt: PAMMediaType;
  3129. begin
  3130.   cmt := nil;
  3131.   //  If we're skipping 0 elements we're guaranteed to skip the
  3132.   //  correct number of elements
  3133.   if (cMediaTypes = 0) then
  3134.   begin
  3135.     result := S_OK;
  3136.     exit;
  3137.   end;
  3138.   // Check we are still in sync with the pin
  3139.   if AreWeOutOfSync then
  3140.   begin
  3141.     result := VFW_E_ENUM_OUT_OF_SYNC;
  3142.     exit;
  3143.   end;
  3144.  
  3145.   FPosition := FPosition + cMediaTypes;
  3146.  
  3147.   // See if we're over the end
  3148.   if (S_OK = FPin.GetMediaType(FPosition - 1, cmt)) then result := S_OK else result := S_FALSE;
  3149. end;
  3150.  
  3151. { TBCBaseOutputPin }
  3152.  
  3153. // Commit the allocator's memory, this is called through IMediaFilter
  3154. // which is responsible for locking the object before calling us
  3155.  
  3156. function TBCBaseOutputPin.Active: HRESULT;
  3157. begin
  3158.   if (FAllocator = nil) then
  3159.        result := VFW_E_NO_ALLOCATOR
  3160.   else result := FAllocator.Commit;
  3161. end;
  3162.  
  3163. function TBCBaseOutputPin.BeginFlush: HRESULT;
  3164. begin
  3165.   result := E_UNEXPECTED;
  3166. end;
  3167.  
  3168. // Overriden from CBasePin
  3169. function TBCBaseOutputPin.BreakConnect: HRESULT;
  3170. begin
  3171.   // Release any allocator we hold
  3172.   if (FAllocator <> nil) then
  3173.   begin
  3174.     // Always decommit the allocator because a downstream filter may or
  3175.     // may not decommit the connection's allocator.  A memory leak could
  3176.     // occur if the allocator is not decommited when a connection is broken.
  3177.     result := FAllocator.Decommit;
  3178.     if FAILED(result) then exit;
  3179.     FAllocator := nil;
  3180.   end;
  3181.  
  3182.   // Release any input pin interface we hold
  3183.   if (FInputPin <> nil) then FInputPin := nil;
  3184.   result := NOERROR;
  3185. end;
  3186.  
  3187. { This method is called when the output pin is about to try and connect to
  3188.   an input pin. It is at this point that you should try and grab any extra
  3189.   interfaces that you need, in this case IMemInputPin. Because this is
  3190.   only called if we are not currently connected we do NOT need to call
  3191.   BreakConnect. This also makes it easier to derive classes from us as
  3192.   BreakConnect is only called when we actually have to break a connection
  3193.   (or a partly made connection) and not when we are checking a connection }
  3194.  
  3195. function TBCBaseOutputPin.CheckConnect(Pin: IPin): HRESULT;
  3196. begin
  3197.   result := inherited CheckConnect(Pin);
  3198.   if FAILED(result) then exit;
  3199.  
  3200.   // get an input pin and an allocator interface
  3201.   result := Pin.QueryInterface(IID_IMemInputPin, FInputPin);
  3202.   if FAILED(result) then exit;
  3203.   result := NOERROR;
  3204. end;
  3205.  
  3206. // This is called after a media type has been proposed
  3207. // Try to complete the connection by agreeing the allocator
  3208. function TBCBaseOutputPin.CompleteConnect(ReceivePin: IPin): HRESULT;
  3209. begin
  3210.   result := DecideAllocator(FInputPin, FAllocator);
  3211. end;
  3212.  
  3213. constructor TBCBaseOutputPin.Create(ObjectName: string;
  3214.   Filter: TBCBaseFilter; Lock: TBCCritSec; out hr: HRESULT;
  3215.   Name: WideString);
  3216. begin
  3217.   inherited Create(ObjectName, Filter, Lock, hr, Name, PINDIR_OUTPUT);
  3218.   FAllocator := nil;
  3219.   FInputPin  := nil;
  3220.   ASSERT(FFilter <> nil);
  3221. end;
  3222.  
  3223. { Decide on an allocator, override this if you want to use your own allocator
  3224.   Override DecideBufferSize to call SetProperties. If the input pin fails
  3225.   the GetAllocator call then this will construct a CMemAllocator and call
  3226.   DecideBufferSize on that, and if that fails then we are completely hosed.
  3227.   If the you succeed the DecideBufferSize call, we will notify the input
  3228.   pin of the selected allocator. NOTE this is called during Connect() which
  3229.   therefore looks after grabbing and locking the object's critical section }
  3230.  
  3231. // We query the input pin for its requested properties and pass this to
  3232. // DecideBufferSize to allow it to fulfill requests that it is happy
  3233. // with (eg most people don't care about alignment and are thus happy to
  3234. // use the downstream pin's alignment request).
  3235.  
  3236. function TBCBaseOutputPin.DecideAllocator(Pin: IMemInputPin;
  3237.   out Alloc: IMemAllocator): HRESULT;
  3238. var
  3239.   prop: TAllocatorProperties;
  3240. begin
  3241.   Alloc := nil;
  3242.  
  3243.   // get downstream prop request
  3244.   // the derived class may modify this in DecideBufferSize, but
  3245.   // we assume that he will consistently modify it the same way,
  3246.   // so we only get it once
  3247.   ZeroMemory(@prop, sizeof(TAllocatorProperties));
  3248.  
  3249.   // whatever he returns, we assume prop is either all zeros
  3250.   // or he has filled it out.
  3251.   Pin.GetAllocatorRequirements(prop);
  3252.  
  3253.   // if he doesn't care about alignment, then set it to 1
  3254.   if (prop.cbAlign = 0) then prop.cbAlign := 1;
  3255.  
  3256.   // Try the allocator provided by the input pin
  3257.  
  3258.   result := Pin.GetAllocator(Alloc);
  3259.   if SUCCEEDED(result) then
  3260.   begin
  3261.     result := DecideBufferSize(Alloc, @prop);
  3262.     if SUCCEEDED(result) then
  3263.     begin
  3264.       result := Pin.NotifyAllocator(Alloc, FALSE);
  3265.       if SUCCEEDED(result) then
  3266.       begin
  3267.         result := NOERROR;
  3268.         exit;
  3269.       end;
  3270.     end;
  3271.   end;
  3272.  
  3273.   // If the GetAllocator failed we may not have an interface
  3274.  
  3275.   if (Alloc <> nil) then Alloc := nil;
  3276.  
  3277.   // Try the output pin's allocator by the same method
  3278.  
  3279.   result := InitAllocator(Alloc);
  3280.   if SUCCEEDED(result) then
  3281.   begin
  3282.     // note - the properties passed here are in the same
  3283.     // structure as above and may have been modified by
  3284.     // the previous call to DecideBufferSize
  3285.     result := DecideBufferSize(Alloc, @prop);
  3286.     if SUCCEEDED(result) then
  3287.     begin
  3288.       result := Pin.NotifyAllocator(Alloc, FALSE);
  3289.       if SUCCEEDED(result) then
  3290.       begin
  3291.         result := NOERROR;
  3292.         exit;
  3293.       end;
  3294.     end;
  3295.   end;
  3296.   // Likewise we may not have an interface to release
  3297.   if (Alloc <> nil) then Alloc := nil;
  3298. end;
  3299.  
  3300. function TBCBaseOutputPin.DecideBufferSize(Alloc: IMemAllocator;
  3301.   propInputRequest: PAllocatorProperties): HRESULT;
  3302. begin
  3303.   result := S_OK; // ???
  3304. end;
  3305.  
  3306. { Deliver a filled-in sample to the connected input pin. NOTE the object must
  3307.   have locked itself before calling us otherwise we may get halfway through
  3308.   executing this method only to find the filter graph has got in and
  3309.   disconnected us from the input pin. If the filter has no worker threads
  3310.   then the lock is best applied on Receive(), otherwise it should be done
  3311.   when the worker thread is ready to deliver. There is a wee snag to worker
  3312.   threads that this shows up. The worker thread must lock the object when
  3313.   it is ready to deliver a sample, but it may have to wait until a state
  3314.   change has completed, but that may never complete because the state change
  3315.   is waiting for the worker thread to complete. The way to handle this is for
  3316.   the state change code to grab the critical section, then set an abort event
  3317.   for the worker thread, then release the critical section and wait for the
  3318.   worker thread to see the event we set and then signal that it has finished
  3319.   (with another event). At which point the state change code can complete }
  3320.  
  3321. // note (if you've still got any breath left after reading that) that you
  3322. // need to release the sample yourself after this call. if the connected
  3323. // input pin needs to hold onto the sample beyond the call, it will addref
  3324. // the sample itself.
  3325.  
  3326. // of course you must release this one and call GetDeliveryBuffer for the
  3327. // next. You cannot reuse it directly.
  3328.  
  3329. function TBCBaseOutputPin.Deliver(Sample: IMediaSample): HRESULT;
  3330. begin
  3331.   if (FInputPin = nil) then result := VFW_E_NOT_CONNECTED
  3332.                        else result := FInputPin.Receive(Sample);
  3333. end;
  3334.  
  3335. // call BeginFlush on the connected input pin
  3336. function TBCBaseOutputPin.DeliverBeginFlush: HRESULT;
  3337. begin
  3338.   // remember this is on IPin not IMemInputPin
  3339.   if (FConnected = nil) then
  3340.        result := VFW_E_NOT_CONNECTED
  3341.   else result := FConnected.BeginFlush;
  3342. end;
  3343.  
  3344. // call EndFlush on the connected input pin
  3345. function TBCBaseOutputPin.DeliverEndFlush: HRESULT;
  3346. begin
  3347.   // remember this is on IPin not IMemInputPin
  3348.   if (FConnected = nil) then
  3349.        result := VFW_E_NOT_CONNECTED
  3350.   else result := FConnected.EndFlush;
  3351. end;
  3352.  
  3353. // called from elsewhere in our filter to pass EOS downstream to
  3354. // our connected input pin
  3355.  
  3356. function TBCBaseOutputPin.DeliverEndOfStream: HRESULT;
  3357. begin
  3358.   // remember this is on IPin not IMemInputPin
  3359.   if (FConnected = nil) then
  3360.        result := VFW_E_NOT_CONNECTED
  3361.   else result := FConnected.EndOfStream;
  3362. end;
  3363.  
  3364. // deliver NewSegment to connected pin
  3365. function TBCBaseOutputPin.DeliverNewSegment(Start, Stop: TReferenceTime;
  3366.   Rate: double): HRESULT;
  3367. begin
  3368.   if (FConnected = nil) then
  3369.        result := VFW_E_NOT_CONNECTED
  3370.   else result := FConnected.NewSegment(Start, Stop, Rate);
  3371. end;
  3372.  
  3373. function TBCBaseOutputPin.EndFlush: HRESULT;
  3374. begin
  3375.   result := E_UNEXPECTED;
  3376. end;
  3377.  
  3378. // we have a default handling of EndOfStream which is to return
  3379. // an error, since this should be called on input pins only
  3380. function TBCBaseOutputPin.EndOfStream: HRESULT;
  3381. begin
  3382.   result := E_UNEXPECTED;
  3383. end;
  3384.  
  3385. // This returns an empty sample buffer from the allocator WARNING the same
  3386. // dangers and restrictions apply here as described below for Deliver()
  3387.  
  3388. function TBCBaseOutputPin.GetDeliveryBuffer(out Sample: IMediaSample;
  3389.   StartTime, EndTime: PReferenceTime; Flags: Longword): HRESULT;
  3390. begin
  3391.   if (FAllocator <> nil) then
  3392.        result := FAllocator.GetBuffer(Sample, StartTime, EndTime, Flags)
  3393.   else result := E_NOINTERFACE;
  3394. end;
  3395.  
  3396. { Free up or unprepare allocator's memory, this is called through
  3397.   IMediaFilter which is responsible for locking the object first }
  3398.  
  3399. function TBCBaseOutputPin.Inactive: HRESULT;
  3400. begin
  3401.   FRunTimeError := FALSE;
  3402.   if (FAllocator = nil) then
  3403.        result := VFW_E_NO_ALLOCATOR
  3404.   else result := FAllocator.Decommit;
  3405. end;
  3406.  
  3407. // This is called when the input pin didn't give us a valid allocator
  3408. function TBCBaseOutputPin.InitAllocator(out Alloc: IMemAllocator): HRESULT;
  3409. begin
  3410.   result := CoCreateInstance(CLSID_MemoryAllocator, nil, CLSCTX_INPROC_SERVER,
  3411.     IID_IMemAllocator, Alloc);
  3412. end;
  3413.  
  3414. { TBCBaseInputPin }
  3415.  
  3416. // Default handling for BeginFlush - call at the beginning
  3417. // of your implementation (makes sure that all Receive calls
  3418. // fail). After calling this, you need to free any queued data
  3419. // and then call downstream.
  3420.  
  3421. function TBCBaseInputPin.BeginFlush: HRESULT;
  3422. begin
  3423.     //  BeginFlush is NOT synchronized with streaming but is part of
  3424.     //  a control action - hence we synchronize with the filter
  3425.   FLock.Lock;
  3426.   try
  3427.     // if we are already in mid-flush, this is probably a mistake
  3428.     // though not harmful - try to pick it up for now so I can think about it
  3429.     ASSERT(not FFlushing);
  3430.     // first thing to do is ensure that no further Receive calls succeed
  3431.     FFlushing := TRUE;
  3432.     // now discard any data and call downstream - must do that
  3433.     // in derived classes
  3434.     result := S_OK;
  3435.   finally
  3436.     FLock.UnLock;
  3437.   end;
  3438.  
  3439. end;
  3440.  
  3441. function TBCBaseInputPin.BreakConnect: HRESULT;
  3442. begin
  3443.   // We don't need our allocator any more
  3444.   if (FAllocator <> nil) then
  3445.   begin
  3446.     // Always decommit the allocator because a downstream filter may or
  3447.     // may not decommit the connection's allocator.  A memory leak could
  3448.     // occur if the allocator is not decommited when a pin is disconnected.
  3449.     result := FAllocator.Decommit;
  3450.     if FAILED(result) then exit;
  3451.     FAllocator := nil;
  3452.   end;
  3453.   result := S_OK;
  3454. end;
  3455.  
  3456. //  Check if it's OK to process data
  3457.  
  3458. function TBCBaseInputPin.CheckStreaming: HRESULT;
  3459. begin
  3460.   //  Shouldn't be able to get any data if we're not connected!
  3461.   ASSERT(IsConnected);
  3462.   //  Don't process stuff in Stopped state
  3463.   if IsStopped then begin result := VFW_E_WRONG_STATE; exit end;
  3464.   if FFlushing then begin result := S_FALSE; exit end;
  3465.   if FRunTimeError then begin result := VFW_E_RUNTIME_ERROR; exit end;
  3466.   result := S_OK;
  3467. end;
  3468.  
  3469. // Constructor creates a default allocator object
  3470.  
  3471. constructor TBCBaseInputPin.Create(ObjectName: string;
  3472.   Filter: TBCBaseFilter; Lock: TBCCritSec; out hr: HRESULT;
  3473.   Name: WideString);
  3474. begin
  3475.     inherited create(ObjectName, Filter, Lock, hr, Name, PINDIR_INPUT);
  3476.     FAllocator := nil;
  3477.     FReadOnly  := false;
  3478.     FFlushing  := false;
  3479.     ZeroMemory(@FSampleProps, sizeof(FSampleProps));
  3480. end;
  3481.  
  3482. destructor TBCBaseInputPin.Destroy;
  3483. begin
  3484.   if FAllocator <> nil then FAllocator := nil;
  3485.   inherited;
  3486. end;
  3487.  
  3488. // default handling for EndFlush - call at end of your implementation
  3489. // - before calling this, ensure that there is no queued data and no thread
  3490. // pushing any more without a further receive, then call downstream,
  3491. // then call this method to clear the m_bFlushing flag and re-enable
  3492. // receives
  3493.  
  3494. function TBCBaseInputPin.EndFlush: HRESULT;
  3495. begin
  3496.     //  Endlush is NOT synchronized with streaming but is part of
  3497.     //  a control action - hence we synchronize with the filter
  3498.   FLock.Lock;
  3499.   try
  3500.     // almost certainly a mistake if we are not in mid-flush
  3501.     ASSERT(FFlushing);
  3502.     // before calling, sync with pushing thread and ensure
  3503.     // no more data is going downstream, then call EndFlush on
  3504.     // downstream pins.
  3505.     // now re-enable Receives
  3506.     FFlushing := FALSE;
  3507.     // No more errors
  3508.     FRunTimeError := FALSE;
  3509.     result := S_OK;
  3510.   finally
  3511.     FLock.UnLock;
  3512.   end;
  3513. end;
  3514.  
  3515. { Return the allocator interface that this input pin would like the output
  3516.    pin to use. NOTE subsequent calls to GetAllocator should all return an
  3517.    interface onto the SAME object so we create one object at the start
  3518.  
  3519.    Note:
  3520.        The allocator is Release()'d on disconnect and replaced on
  3521.        NotifyAllocator().
  3522.  
  3523.    Override this to provide your own allocator.}
  3524. function TBCBaseInputPin.GetAllocator(
  3525.   out ppAllocator: IMemAllocator): HRESULT;
  3526. begin
  3527.   FLock.Lock;
  3528.   try
  3529.     if (FAllocator = nil) then
  3530.     begin
  3531.       result := CoCreateInstance(CLSID_MemoryAllocator, nil, CLSCTX_INPROC_SERVER,
  3532.         IID_IMemAllocator, FAllocator);
  3533.       if FAILED(result) then exit;
  3534.     end;
  3535.     ASSERT(FAllocator <> nil);
  3536.     ppAllocator := FAllocator;
  3537.     result := NOERROR;
  3538.   finally
  3539.     FLock.UnLock;
  3540.   end;
  3541. end;
  3542.  
  3543. // what requirements do we have of the allocator - override if you want
  3544. // to support other people's allocators but need a specific alignment
  3545. // or prefix.
  3546.  
  3547. function TBCBaseInputPin.GetAllocatorRequirements(
  3548.   out pProps: TAllocatorProperties): HRESULT;
  3549. begin
  3550.   result := E_NOTIMPL;
  3551. end;
  3552.  
  3553. { Free up or unprepare allocator's memory, this is called through
  3554.   IMediaFilter which is responsible for locking the object first. }
  3555.  
  3556. function TBCBaseInputPin.Inactive: HRESULT;
  3557. begin
  3558.   FRunTimeError := FALSE;
  3559.   if (FAllocator = nil) then
  3560.   begin
  3561.     result := VFW_E_NO_ALLOCATOR;
  3562.     exit;
  3563.   end;
  3564.   FFlushing := FALSE;
  3565.   result := FAllocator.Decommit;
  3566. end;
  3567.  
  3568. function TBCBaseInputPin.Notify(pSelf: IBaseFilter; q: TQuality): HRESULT;
  3569. begin
  3570.   DbgLog(self, 'IQuality.Notify called on an input pin');
  3571.   result := NOERROR;
  3572. end;
  3573.  
  3574. { Tell the input pin which allocator the output pin is actually going to use
  3575.   Override this if you care - NOTE the locking we do both here and also in
  3576.   GetAllocator is unnecessary but derived classes that do something useful
  3577.   will undoubtedly have to lock the object so this might help remind people }
  3578.  
  3579. function TBCBaseInputPin.NotifyAllocator(pAllocator: IMemAllocator;
  3580.   bReadOnly: BOOL): HRESULT;
  3581. begin
  3582.   FLock.Lock;
  3583.   try
  3584.     FAllocator := pAllocator;
  3585.     // the readonly flag indicates whether samples from this allocator should
  3586.     // be regarded as readonly - if true, then inplace transforms will not be
  3587.     // allowed.
  3588.     FReadOnly := bReadOnly;
  3589.     result    := NOERROR;
  3590.   finally
  3591.     FLock.UnLock;
  3592.   end;
  3593. end;
  3594.  
  3595. // Pass on the Quality notification q to
  3596. // a. Our QualityControl sink (if we have one) or else
  3597. // b. to our upstream filter
  3598. // and if that doesn't work, throw it away with a bad return code
  3599.  
  3600. function TBCBaseInputPin.PassNotify(const q: TQuality): HRESULT;
  3601. var IQC: IQualityControl;
  3602. begin
  3603.   // We pass the message on, which means that we find the quality sink
  3604.   // for our input pin and send it there
  3605.  
  3606.   DbgLog(self, 'Passing Quality notification through transform');
  3607.   if (FQSink <> nil) then
  3608.     begin
  3609.       result := FQSink.Notify(FFilter, q);
  3610.       exit;
  3611.     end
  3612.   else
  3613.     begin
  3614.       // no sink set, so pass it upstream
  3615.       result := VFW_E_NOT_FOUND;                   // default
  3616.       if (FConnected <> nil) then
  3617.       begin
  3618.         FConnected.QueryInterface(IID_IQualityControl, IQC);
  3619.         if (IQC <> nil) then
  3620.         begin
  3621.           result := IQC.Notify(FFilter, q);
  3622.           IQC := nil;
  3623.         end;
  3624.       end;
  3625.     end;
  3626. end;
  3627.  
  3628. { Do something with this media sample - this base class checks to see if the
  3629.   format has changed with this media sample and if so checks that the filter
  3630.   will accept it, generating a run time error if not. Once we have raised a
  3631.   run time error we set a flag so that no more samples will be accepted
  3632.   It is important that any filter should override this method and implement
  3633.   synchronization so that samples are not processed when the pin is
  3634.   disconnected etc. }
  3635.  
  3636. function TBCBaseInputPin.Receive(pSample: IMediaSample): HRESULT;
  3637. var Sample2: IMediaSample2;
  3638. begin
  3639.   ASSERT(pSample <> nil);
  3640.  
  3641.   result := CheckStreaming;
  3642.   if (S_OK <> result) then exit;
  3643.  
  3644.   // Check for IMediaSample2
  3645.   if SUCCEEDED(pSample.QueryInterface(IID_IMediaSample2, Sample2)) then
  3646.     begin
  3647.       result := Sample2.GetProperties(sizeof(FSampleProps), FSampleProps);
  3648.       Sample2 := nil;
  3649.       if FAILED(result) then exit;
  3650.     end
  3651.   else
  3652.     begin
  3653.       //  Get the properties the hard way
  3654.       FSampleProps.cbData := sizeof(FSampleProps);
  3655.       FSampleProps.dwTypeSpecificFlags := 0;
  3656.       FSampleProps.dwStreamId          := AM_STREAM_MEDIA;
  3657.       FSampleProps.dwSampleFlags       := 0;
  3658.       if (S_OK = pSample.IsDiscontinuity) then
  3659.           FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_DATADISCONTINUITY;
  3660.       if (S_OK = pSample.IsPreroll) then
  3661.           FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_PREROLL;
  3662.       if (S_OK = pSample.IsSyncPoint) then
  3663.           FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_SPLICEPOINT;
  3664.       if SUCCEEDED(pSample.GetTime(FSampleProps.tStart, FSampleProps.tStop)) then
  3665.           FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_TIMEVALID or AM_SAMPLE_STOPVALID;
  3666.       if (S_OK = pSample.GetMediaType(FSampleProps.pMediaType)) then
  3667.           FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_TYPECHANGED;
  3668.       pSample.GetPointer(PByte(FSampleProps.pbBuffer));
  3669.       FSampleProps.lActual := pSample.GetActualDataLength;
  3670.       FSampleProps.cbBuffer := pSample.GetSize;
  3671.     end;
  3672.  
  3673.   // Has the format changed in this sample
  3674.  
  3675.   if (not BOOL(FSampleProps.dwSampleFlags and AM_SAMPLE_TYPECHANGED)) then
  3676.   begin
  3677.     result := NOERROR;
  3678.     exit;
  3679.   end;
  3680.  
  3681.   // Check the derived class accepts this format */
  3682.   // This shouldn't fail as the source must call QueryAccept first */
  3683.  
  3684.   result := CheckMediaType(FSampleProps.pMediaType);
  3685.  
  3686.   if (result = NOERROR) then exit;
  3687.  
  3688.   // Raise a runtime error if we fail the media type
  3689.  
  3690.   FRunTimeError := TRUE;
  3691.   EndOfStream;
  3692.   FFilter.NotifyEvent(EC_ERRORABORT,VFW_E_TYPE_NOT_ACCEPTED,0);
  3693.   result := VFW_E_INVALIDMEDIATYPE;
  3694. end;
  3695.  
  3696. // See if Receive() might block
  3697.  
  3698. function TBCBaseInputPin.ReceiveCanBlock: HRESULT;
  3699. var
  3700.   c, Pins, OutputPins: Integer;
  3701.   Pin: TBCBasePin;
  3702.   pd: TPinDirection;
  3703.   Connected: IPin;
  3704.   InputPin: IMemInputPin;
  3705. begin
  3706.   { Ask all the output pins if they block
  3707.     If there are no output pin assume we do block. }
  3708.   Pins := FFilter.GetPinCount;
  3709.   OutputPins := 0;
  3710.   for c := 0 to Pins - 1 do
  3711.   begin
  3712.     Pin := FFilter.GetPin(c);
  3713.     result := Pin.QueryDirection(pd);
  3714.     if FAILED(result) then exit;
  3715.     if (pd = PINDIR_OUTPUT) then
  3716.     begin
  3717.       result := Pin.ConnectedTo(Connected);
  3718.       if SUCCEEDED(result) then
  3719.       begin
  3720.         assert(Connected <> nil);
  3721.         inc(OutputPins);
  3722.         result := Connected.QueryInterface(IID_IMemInputPin, InputPin);
  3723.         Connected := nil;
  3724.         if SUCCEEDED(result) then
  3725.           begin
  3726.             result := InputPin.ReceiveCanBlock;
  3727.             InputPin := nil;
  3728.             if (result <> S_FALSE) then
  3729.               begin
  3730.                 result := S_OK;
  3731.                 exit;
  3732.               end;
  3733.           end
  3734.         else
  3735.           begin
  3736.             // There's a transport we don't understand here
  3737.             result := S_OK;
  3738.             exit;
  3739.           end;
  3740.       end;
  3741.     end;
  3742.   end;
  3743.   if OutputPins = 0 then result := S_OK else result := S_FALSE;
  3744. end;
  3745.  
  3746. //  Receive multiple samples
  3747.  
  3748. function TBCBaseInputPin.ReceiveMultiple(var pSamples: IMediaSample;
  3749.   nSamples: Integer; out nSamplesProcessed: Integer): HRESULT;
  3750. type
  3751.   TMediaSampleDynArray = array of IMediaSample;
  3752. begin
  3753.   result := S_OK;
  3754.   nSamplesProcessed := 0;
  3755.   dec(nSamples);
  3756.   while (nSamples >= 0) do
  3757.   begin
  3758.     result := Receive(TMediaSampleDynArray(@pSamples)[nSamplesProcessed]);
  3759.     //  S_FALSE means don't send any more
  3760.     if (result <> S_OK) then break;
  3761.     inc(nSamplesProcessed);
  3762.     dec(nSamples)
  3763.   end;
  3764. end;
  3765.  
  3766. function TBCBaseInputPin.SampleProps: PAMSample2Properties;
  3767. begin
  3768.   ASSERT(FSampleProps.cbData <> 0);
  3769.   result := @FSampleProps;
  3770. end;
  3771.  
  3772. { TBCTransformInputPin }
  3773.  
  3774. // enter flushing state. Call default handler to block Receives, then
  3775. // pass to overridable method in filter
  3776.  
  3777. function TBCTransformInputPin.BeginFlush: HRESULT;
  3778. begin
  3779.   FTransformFilter.FcsFilter.Lock;
  3780.   try
  3781.     //  Are we actually doing anything?
  3782.     ASSERT(FTransformFilter.FOutput <> nil);
  3783.     if ((not IsConnected) or (not FTransformFilter.FOutput.IsConnected)) then
  3784.       begin
  3785.         result := VFW_E_NOT_CONNECTED;
  3786.         exit;
  3787.       end;
  3788.     result := inherited BeginFlush;
  3789.     if FAILED(result) then exit;
  3790.     result := FTransformFilter.BeginFlush;
  3791.   finally
  3792.     FTransformFilter.FcsFilter.UnLock;
  3793.   end;
  3794. end;
  3795.  
  3796. // provides derived filter a chance to release it's extra interfaces
  3797.  
  3798. function TBCTransformInputPin.BreakConnect: HRESULT;
  3799. begin
  3800.   ASSERT(IsStopped);
  3801.   FTransformFilter.BreakConnect(PINDIR_INPUT);
  3802.   result := inherited BreakConnect;
  3803. end;
  3804.  
  3805. function TBCTransformInputPin.CheckConnect(Pin: IPin): HRESULT;
  3806. begin
  3807.   result := FTransformFilter.CheckConnect(PINDIR_INPUT, Pin);
  3808.   if FAILED(result) then exit;
  3809.   result := inherited CheckConnect(Pin);
  3810. end;
  3811.  
  3812. // check that we can support a given media type
  3813.  
  3814. function TBCTransformInputPin.CheckMediaType(
  3815.   mtIn: PAMMediaType): HRESULT;
  3816. begin
  3817.   // Check the input type
  3818.   result := FTransformFilter.CheckInputType(mtIn);
  3819.   if (S_OK <> result) then exit;
  3820.   // if the output pin is still connected, then we have
  3821.   // to check the transform not just the input format
  3822.   if ((FTransformFilter.FOutput <> nil) and
  3823.       (FTransformFilter.FOutput.IsConnected)) then
  3824.     begin
  3825.       result := FTransformFilter.CheckTransform(mtIn,
  3826.           FTransformFilter.FOutput.AMMediaType);
  3827.     end;
  3828. end;
  3829.  
  3830. function TBCTransformInputPin.CheckStreaming: HRESULT;
  3831. begin
  3832.   ASSERT(FTransformFilter.FOutput <> nil);
  3833.   if(not FTransformFilter.FOutput.IsConnected) then
  3834.     begin
  3835.       result := VFW_E_NOT_CONNECTED;
  3836.       exit;
  3837.     end
  3838.   else
  3839.     begin
  3840.       //  Shouldn't be able to get any data if we're not connected!
  3841.       ASSERT(IsConnected);
  3842.       //  we're flushing
  3843.       if FFlushing then
  3844.         begin
  3845.           result := S_FALSE;
  3846.           exit;
  3847.         end;
  3848.       //  Don't process stuff in Stopped state
  3849.       if IsStopped then
  3850.         begin
  3851.           result := VFW_E_WRONG_STATE;
  3852.           exit;
  3853.         end;
  3854.       if FRunTimeError then
  3855.         begin
  3856.           result := VFW_E_RUNTIME_ERROR;
  3857.           exit;
  3858.         end;
  3859.       result := S_OK;
  3860.     end;
  3861. end;
  3862.  
  3863. function TBCTransformInputPin.CompleteConnect(ReceivePin: IPin): HRESULT;
  3864. begin
  3865.   result := FTransformFilter.CompleteConnect(PINDIR_INPUT, ReceivePin);
  3866.   if FAILED(result) then exit;
  3867.   result := inherited CompleteConnect(ReceivePin);
  3868. end;
  3869.  
  3870. constructor TBCTransformInputPin.Create(ObjectName: string;
  3871.   TransformFilter: TBCTransformFilter; out hr: HRESULT; Name: WideString);
  3872. begin
  3873.   inherited  Create(ObjectName, TransformFilter, TransformFilter.FcsFilter, hr, Name);
  3874.   DbgLog(self, 'TBCTransformInputPin.Create');
  3875.   FTransformFilter := TransformFilter;
  3876. end;
  3877.  
  3878. // leave flushing state.
  3879. // Pass to overridable method in filter, then call base class
  3880. // to unblock receives (finally)
  3881.  
  3882. destructor TBCTransformInputPin.destroy;
  3883. begin
  3884.   DbgLog(self, 'TBCTransformInputPin.destroy');
  3885.   inherited;
  3886. end;
  3887.  
  3888. function TBCTransformInputPin.EndFlush: HRESULT;
  3889. begin
  3890.   FTransformFilter.FcsFilter.Lock;
  3891.   try
  3892.     //  Are we actually doing anything?
  3893.     ASSERT(FTransformFilter.FOutput <> nil);
  3894.     if((not IsConnected) or (not FTransformFilter.FOutput.IsConnected)) then
  3895.       begin
  3896.         result := VFW_E_NOT_CONNECTED;
  3897.         exit;
  3898.       end;
  3899.  
  3900.     result := FTransformFilter.EndFlush;
  3901.     if FAILED(result) then exit;
  3902.     result := inherited EndFlush;
  3903.   finally
  3904.     FTransformFilter.FcsFilter.UnLock;
  3905.   end;
  3906. end;
  3907.  
  3908. // provide EndOfStream that passes straight downstream
  3909. // (there is no queued data)
  3910.  
  3911. function TBCTransformInputPin.EndOfStream: HRESULT;
  3912. begin
  3913.   FTransformFilter.FcsReceive.Lock;
  3914.   try
  3915.     result := CheckStreaming;
  3916.     if (S_OK = result) then
  3917.       result := FTransformFilter.EndOfStream;
  3918.   finally
  3919.     FTransformFilter.FcsReceive.UnLock;
  3920.   end;
  3921. end;
  3922.  
  3923. function TBCTransformInputPin.NewSegment(Start, Stop: TReferenceTime;
  3924.   Rate: double): HRESULT;
  3925. begin
  3926.   //  Save the values in the pin
  3927.   inherited NewSegment(Start, Stop, Rate);
  3928.   result := FTransformFilter.NewSegment(Start, Stop, Rate);
  3929. end;
  3930.  
  3931. function TBCTransformInputPin.QueryId(out id: PWideChar): HRESULT;
  3932. begin
  3933.   AMGetWideString('In', Id);
  3934.   if id <> nil then result := S_OK else result := S_FALSE;
  3935. end;
  3936.  
  3937. // here's the next block of data from the stream.
  3938. // AddRef it yourself if you need to hold it beyond the end
  3939. // of this call.
  3940.  
  3941. function TBCTransformInputPin.Receive(pSample: IMediaSample): HRESULT;
  3942. begin
  3943.   FTransformFilter.FcsReceive.Lock;
  3944.   try
  3945.     ASSERT(pSample <> nil);
  3946.     // check all is well with the base class
  3947.     result := inherited Receive(pSample);
  3948.     if (result = S_OK) then
  3949.       result := FTransformFilter.Receive(pSample);
  3950.   finally
  3951.     FTransformFilter.FcsReceive.Unlock;
  3952.   end;
  3953. end;
  3954.  
  3955. // set the media type for this connection
  3956.  
  3957. function TBCTransformInputPin.SetMediaType(mt: PAMMediaType): HRESULT;
  3958. begin
  3959.   // Set the base class media type (should always succeed)
  3960.   result := inherited SetMediaType(mt);
  3961.   if FAILED(result) then exit;
  3962.   // check the transform can be done (should always succeed)
  3963.   ASSERT(SUCCEEDED(FTransformFilter.CheckInputType(mt)));
  3964.   result := FTransformFilter.SetMediaType(PINDIR_INPUT,mt);
  3965. end;
  3966.  
  3967. { TBCCritSec }
  3968.  
  3969. constructor TBCCritSec.Create;
  3970. begin
  3971.   InitializeCriticalSection(FCritSec);
  3972.   {$IFDEF DEBUG}
  3973.      FcurrentOwner := 0;
  3974.      FlockCount    := 0;
  3975.      {$IFDEF TRACE}
  3976.      FTrace        := TRUE;
  3977.      {$ELSE}
  3978.      FTrace        := FALSE;
  3979.      {$ENDIF}
  3980.   {$ENDIF}
  3981. end;
  3982.  
  3983. function TBCCritSec.CritCheckIn: boolean;
  3984. begin
  3985.   {$IFDEF DEBUG}
  3986.     result := (GetCurrentThreadId = Self.FcurrentOwner);
  3987.   {$ELSE}
  3988.     result := true;
  3989.   {$ENDIF}
  3990. end;
  3991.  
  3992. function TBCCritSec.CritCheckOut: boolean;
  3993. begin
  3994.   {$IFDEF DEBUG}
  3995.   result := (GetCurrentThreadId <> Self.FcurrentOwner);
  3996.   {$ELSE}
  3997.     result := false;
  3998.   {$ENDIF}
  3999. end;
  4000.  
  4001. destructor TBCCritSec.Destroy;
  4002. begin
  4003.   DeleteCriticalSection(FCritSec)
  4004. end;
  4005.  
  4006. procedure TBCCritSec.Lock;
  4007. begin
  4008.   {$IFDEF DEBUG}
  4009.     if ((FCurrentOwner <> 0)  and (FCurrentOwner <> GetCurrentThreadId)) then
  4010.     begin
  4011.       // already owned, but not by us
  4012.       if FTrace then
  4013.       begin
  4014.         DbgLog(nil, format('Thread %d about to wait for lock %x owned by %d',
  4015.           [GetCurrentThreadId, longint(self), FCurrentOwner]));
  4016.       end;
  4017.     end;
  4018.   {$ENDIF}
  4019.     EnterCriticalSection(FCritSec);
  4020.   {$IFDEF DEBUG}
  4021.     inc(FLockCount);
  4022.     if (FLockCount > 0) then
  4023.     begin
  4024.       // we now own it for the first time.  Set owner information
  4025.       FcurrentOwner := GetCurrentThreadId;
  4026.       if FTrace then
  4027.         DbgLog(nil, format('Thread %d now owns lock %x', [FcurrentOwner, LongInt(self)]));
  4028.     end;
  4029.   {$ENDIF}
  4030. end;
  4031.  
  4032. procedure TBCCritSec.UnLock;
  4033. begin
  4034.   {$IFDEF DEBUG}
  4035.      dec(FlockCount);
  4036.      if(FlockCount = 0) then
  4037.      begin
  4038.        // about to be unowned
  4039.        if FTrace then
  4040.          DbgLog(nil, format('Thread %d releasing lock %x', [FcurrentOwner, LongInt(Self)]));
  4041.        FcurrentOwner := 0;
  4042.     end;
  4043.   {$ENDIF}
  4044.   LeaveCriticalSection(FCritSec)
  4045. end;
  4046.  
  4047. { TBCTransformFilter }
  4048.  
  4049. // Return S_FALSE to mean "pass the note on upstream"
  4050. // Return NOERROR (Same as S_OK)
  4051. // to mean "I've done something about it, don't pass it on"
  4052.  
  4053. function TBCTransformFilter.AlterQuality(const q: TQuality): HRESULT;
  4054. begin
  4055.   result := S_FALSE;
  4056. end;
  4057.  
  4058. // enter flush state. Receives already blocked
  4059. // must override this if you have queued data or a worker thread
  4060.  
  4061. function TBCTransformFilter.BeginFlush: HRESULT;
  4062. begin
  4063.   result := NOERROR;
  4064.   if (FOutput <> nil) then
  4065.     // block receives -- done by caller (CBaseInputPin::BeginFlush)
  4066.     // discard queued data -- we have no queued data
  4067.     // free anyone blocked on receive - not possible in this filter
  4068.     // call downstream
  4069.     result := FOutput.DeliverBeginFlush;
  4070. end;
  4071.  
  4072. function TBCTransformFilter.BreakConnect(dir: TPinDirection): HRESULT;
  4073. begin
  4074.   result := NOERROR;
  4075. end;
  4076.  
  4077. function TBCTransformFilter.CheckConnect(dir: TPinDirection;
  4078.   Pin: IPin): HRESULT;
  4079. begin
  4080.   result := NOERROR;
  4081. end;
  4082.  
  4083. function TBCTransformFilter.CompleteConnect(direction: TPinDirection;
  4084.   ReceivePin: IPin): HRESULT;
  4085. begin
  4086.   result := NOERROR;
  4087. end;
  4088.  
  4089. constructor TBCTransformFilter.Create(ObjectName: string; unk: IUnKnown;
  4090.   const clsid: TGUID);
  4091. begin
  4092.   FcsFilter := TBCCritSec.Create;
  4093.   FcsReceive := TBCCritSec.Create;
  4094.   inherited Create(ObjectName,Unk,FcsFilter, clsid);
  4095.   FInput         := nil;
  4096.   FOutput        := nil;
  4097.   FEOSDelivered  := FALSE;
  4098.   FQualityChanged:= FALSE;
  4099.   FSampleSkipped := FALSE;
  4100. {$ifdef PERF}
  4101.   RegisterPerfId;
  4102. {$endif}
  4103. end;
  4104.  
  4105. constructor TBCTransformFilter.CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown);
  4106. begin
  4107.   Create(Factory.FName, Controller, Factory.FClassID);
  4108. end;
  4109.  
  4110. destructor TBCTransformFilter.destroy;
  4111. begin
  4112.   if FInput <> nil then FInput.Free;
  4113.   if FOutput <> nil then FOutput.Free;
  4114.   DbgLog(self, 'TBCTransformFilter.destroy');
  4115.   FcsReceive.Free;
  4116.   inherited;
  4117. end;
  4118.  
  4119. // leave flush state. must override this if you have queued data
  4120. // or a worker thread
  4121.  
  4122. function TBCTransformFilter.EndFlush: HRESULT;
  4123. begin
  4124.   // sync with pushing thread -- we have no worker thread
  4125.   // ensure no more data to go downstream -- we have no queued data
  4126.   // call EndFlush on downstream pins
  4127.   ASSERT(FOutput <> nil);
  4128.   result := FOutput.DeliverEndFlush;
  4129.   // caller (the input pin's method) will unblock Receives
  4130. end;
  4131.  
  4132. // EndOfStream received. Default behaviour is to deliver straight
  4133. // downstream, since we have no queued data. If you overrode Receive
  4134. // and have queue data, then you need to handle this and deliver EOS after
  4135. // all queued data is sent
  4136.  
  4137. function TBCTransformFilter.EndOfStream: HRESULT;
  4138. begin
  4139.   result := NOERROR;
  4140.   if (FOutput <> nil) then
  4141.     result := FOutput.DeliverEndOfStream;
  4142. end;
  4143.  
  4144. // If Id is In or Out then return the IPin* for that pin
  4145. // creating the pin if need be.  Otherwise return NULL with an error.
  4146.  
  4147. function TBCTransformFilter.FindPin(Id: PWideChar; out ppPin: IPin): HRESULT;
  4148. begin
  4149.     if(WideString(Id) = 'In')  then ppPin := GetPin(0) else
  4150.     if(WideString(Id) = 'Out') then ppPin := GetPin(1) else
  4151.       begin
  4152.         ppPin := nil;
  4153.         result := VFW_E_NOT_FOUND;
  4154.         exit;
  4155.       end;
  4156.  
  4157.    result := NOERROR;
  4158.    if(ppPin = nil) then result := E_OUTOFMEMORY;
  4159. end;
  4160.  
  4161. // return a non-addrefed CBasePin * for the user to addref if he holds onto it
  4162. // for longer than his pointer to us. We create the pins dynamically when they
  4163. // are asked for rather than in the constructor. This is because we want to
  4164. // give the derived class an oppportunity to return different pin objects
  4165.  
  4166. // We return the objects as and when they are needed. If either of these fails
  4167. // then we return NULL, the assumption being that the caller will realise the
  4168. // whole deal is off and destroy us - which in turn will delete everything.
  4169.  
  4170. function TBCTransformFilter.GetPin(n: integer): TBCBasePin;
  4171. var hr: HRESULT;
  4172. begin
  4173.   hr := S_OK;
  4174.   // Create an input pin if necessary
  4175.   if(FInput = nil) then
  4176.   begin
  4177.     FInput := TBCTransformInputPin.Create('Transform input pin',
  4178.         self,        // Owner filter
  4179.         hr,          // Result code
  4180.         'XForm In'); // Pin name
  4181.  
  4182.     //  Can't fail
  4183.     ASSERT(SUCCEEDED(hr));
  4184.     if(FInput = nil) then
  4185.     begin
  4186.       result := nil;
  4187.       exit;
  4188.     end;
  4189.     FOutput := TBCTransformOutputPin.Create('Transform output pin',
  4190.         self,           // Owner filter
  4191.         hr,             // Result code
  4192.         'XForm Out');   // Pin name
  4193.  
  4194.     // Can't fail
  4195.     ASSERT(SUCCEEDED(hr));
  4196.     if(FOutput = nil) then FreeAndNil(FInput);
  4197.   end;
  4198.  
  4199.   // Return the appropriate pin
  4200.  
  4201.   case n of
  4202.     0 : result := FInput;
  4203.     1 : result := FOutput;
  4204.     else
  4205.       result := nil;
  4206.   end;
  4207. end;
  4208.  
  4209. function TBCTransformFilter.GetPinCount: integer;
  4210. begin
  4211.   result := 2;
  4212. end;
  4213.  
  4214. // Set up our output sample
  4215.  
  4216. function TBCTransformFilter.InitializeOutputSample(Sample: IMediaSample;
  4217.   out OutSample: IMediaSample): HRESULT;
  4218. var
  4219.   Props: PAMSample2Properties;
  4220.   Flags: DWORD;
  4221.   Start, Stop: PReferenceTime;
  4222.   OutSample2: IMediaSample2;
  4223.   OutProps: TAMSample2Properties;
  4224.   MediaStart, MediaEnd: Int64;
  4225. begin
  4226.   // default - times are the same
  4227.  
  4228.   Props := FInput.SampleProps;
  4229.   if FSampleSkipped then Flags := AM_GBF_PREVFRAMESKIPPED else Flags := 0;
  4230.  
  4231.   // This will prevent the image renderer from switching us to DirectDraw
  4232.   // when we can't do it without skipping frames because we're not on a
  4233.   // keyframe.  If it really has to switch us, it still will, but then we
  4234.   // will have to wait for the next keyframe
  4235.   if(not BOOL(Props.dwSampleFlags and AM_SAMPLE_SPLICEPOINT)) then Flags := Flags or AM_GBF_NOTASYNCPOINT;
  4236.  
  4237.   ASSERT(FOutput.FAllocator <> nil);
  4238.   if  BOOL(Props.dwSampleFlags and AM_SAMPLE_TIMEVALID) then Start := @Props.tStart else Start := nil;
  4239.   if  BOOL(Props.dwSampleFlags and AM_SAMPLE_STOPVALID) then Stop := @Props.tStop else Stop := nil;
  4240.   result := FOutput.FAllocator.GetBuffer(OutSample, Start, Stop, Flags);
  4241.   if FAILED(result) then exit;
  4242.   ASSERT(OutSample <> nil);
  4243.   if SUCCEEDED(OutSample.QueryInterface(IID_IMediaSample2, OutSample2)) then
  4244.     begin
  4245.       ASSERT(SUCCEEDED(OutSample2.GetProperties(4*4, OutProps)));
  4246.       OutProps.dwTypeSpecificFlags := Props.dwTypeSpecificFlags;
  4247.       OutProps.dwSampleFlags := (OutProps.dwSampleFlags and AM_SAMPLE_TYPECHANGED) or
  4248.           (Props.dwSampleFlags and (not AM_SAMPLE_TYPECHANGED));
  4249.  
  4250.       OutProps.tStart := Props.tStart;
  4251.       OutProps.tStop  := Props.tStop;
  4252.       OutProps.cbData := (4*4) + (2*8);
  4253.  
  4254.       OutSample2.SetProperties((4*4)+(2*8), OutProps);
  4255.       if BOOL(Props.dwSampleFlags and AM_SAMPLE_DATADISCONTINUITY) then FSampleSkipped := FALSE;
  4256.       OutSample2 := nil;
  4257.     end
  4258.   else
  4259.     begin
  4260.       if BOOL(Props.dwSampleFlags and AM_SAMPLE_TIMEVALID) then
  4261.         OutSample.SetTime(@Props.tStart, @Props.tStop);
  4262.       if BOOL(Props.dwSampleFlags and AM_SAMPLE_SPLICEPOINT) then
  4263.         OutSample.SetSyncPoint(TRUE);
  4264.       if BOOL(Props.dwSampleFlags and AM_SAMPLE_DATADISCONTINUITY) then
  4265.         begin
  4266.           OutSample.SetDiscontinuity(TRUE);
  4267.           FSampleSkipped := FALSE;
  4268.         end;
  4269.       // Copy the media times
  4270.       if (Sample.GetMediaTime(MediaStart,MediaEnd) = NOERROR) then
  4271.         OutSample.SetMediaTime(@MediaStart, @MediaEnd);
  4272.     end;
  4273.   result := S_OK;
  4274. end;
  4275.  
  4276. function TBCTransformFilter.NewSegment(Start, Stop: TReferenceTime;
  4277.   Rate: double): HRESULT;
  4278. begin
  4279.   result := S_OK;
  4280.   if (FOutput <> nil) then
  4281.     result := FOutput.DeliverNewSegment(Start, Stop, Rate);
  4282. end;
  4283.  
  4284. function TBCTransformFilter.Pause: HRESULT;
  4285. begin
  4286.   FcsFilter.Lock;
  4287.   try
  4288.     result := NOERROR;
  4289.     if (FState = State_Paused) then
  4290.       begin
  4291.         // (This space left deliberately blank)
  4292.       end
  4293.     // If we have no input pin or it isn't yet connected then when we are
  4294.     // asked to pause we deliver an end of stream to the downstream filter.
  4295.     // This makes sure that it doesn't sit there forever waiting for
  4296.     // samples which we cannot ever deliver without an input connection.
  4297.  
  4298.     else
  4299.       if ((FInput = nil) or (FInput.IsConnected = FALSE)) then
  4300.         begin
  4301.           if ((FOutput <> nil) and (FEOSDelivered = FALSE)) then
  4302.           begin
  4303.             FOutput.DeliverEndOfStream;
  4304.             FEOSDelivered := TRUE;
  4305.           end;
  4306.           FState := State_Paused;
  4307.         end
  4308.  
  4309.     // We may have an input connection but no output connection
  4310.     // However, if we have an input pin we do have an output pin
  4311.  
  4312.     else
  4313.       if (FOutput.IsConnected = FALSE) then
  4314.         FState := State_Paused
  4315.       else
  4316.         begin
  4317.           if(FState = State_Stopped) then
  4318.           begin
  4319.               // allow a class derived from CTransformFilter
  4320.               // to know about starting and stopping streaming
  4321.               FcsReceive.Lock;
  4322.             try
  4323.               result := StartStreaming;
  4324.             finally
  4325.               FcsReceive.UnLock;
  4326.             end;
  4327.           end;
  4328.           if SUCCEEDED(result) then result := inherited Pause;
  4329.         end;
  4330.     FSampleSkipped := FALSE;
  4331.     FQualityChanged := FALSE;
  4332.   finally
  4333.     FcsFilter.UnLock;
  4334.   end;
  4335. end;
  4336.  
  4337. // override this to customize the transform process
  4338.  
  4339. function TBCTransformFilter.Receive(Sample: IMediaSample): HRESULT;
  4340. var
  4341.   Props: PAMSample2Properties;
  4342.   OutSample: IMediaSample;
  4343. begin
  4344.   //  Check for other streams and pass them on
  4345.   Props := FInput.SampleProps;
  4346.   if(Props.dwStreamId <> AM_STREAM_MEDIA) then
  4347.   begin
  4348.     result := FOutput.FInputPin.Receive(Sample);
  4349.     exit;
  4350.   end;
  4351.   // If no output to deliver to then no point sending us data
  4352.   ASSERT(FOutput <> nil) ;
  4353.   // Set up the output sample
  4354.   result := InitializeOutputSample(Sample, OutSample);
  4355.   if FAILED(result) then exit;
  4356.   result := Transform(Sample, OutSample);
  4357.   if FAILED(result) then
  4358.     begin
  4359.       DbgLog(self, 'Error from transform');
  4360.       exit;
  4361.     end
  4362.   else
  4363.     begin
  4364.       // the Transform() function can return S_FALSE to indicate that the
  4365.       // sample should not be delivered; we only deliver the sample if it's
  4366.       // really S_OK (same as NOERROR, of course.)
  4367.       if (result = NOERROR) then
  4368.         begin
  4369.           result := FOutput.FInputPin.Receive(OutSample);
  4370.           FSampleSkipped := FALSE;   // last thing no longer dropped
  4371.         end
  4372.       else
  4373.         begin
  4374.           // S_FALSE returned from Transform is a PRIVATE agreement
  4375.           // We should return NOERROR from Receive() in this cause because returning S_FALSE
  4376.           // from Receive() means that this is the end of the stream and no more data should
  4377.           // be sent.
  4378.           if (result = S_FALSE) then
  4379.           begin
  4380.             //  Release the sample before calling notify to avoid
  4381.             //  deadlocks if the sample holds a lock on the system
  4382.             //  such as DirectDraw buffers do
  4383.             OutSample := nil;
  4384.             FSampleSkipped := TRUE;
  4385.             if not FQualityChanged then
  4386.             begin
  4387.               NotifyEvent(EC_QUALITY_CHANGE,0,0);
  4388.               FQualityChanged := TRUE;
  4389.             end;
  4390.             result := NOERROR;
  4391.             exit;
  4392.           end;
  4393.         end;
  4394.     end;
  4395.   // release the output buffer. If the connected pin still needs it,
  4396.   // it will have addrefed it itself.
  4397.   OutSample := nil;
  4398. end;
  4399.  
  4400. function TBCTransformFilter.SetMediaType(direction: TPinDirection;
  4401.   pmt: PAMMediaType): HRESULT;
  4402. begin
  4403.   result := NOERROR;
  4404. end;
  4405.  
  4406. // override these two functions if you want to inform something
  4407. // about entry to or exit from streaming state.
  4408.  
  4409. function TBCTransformFilter.StartStreaming: HRESULT;
  4410. begin
  4411.   result := NOERROR;
  4412. end;
  4413.  
  4414. // override these so that the derived filter can catch them
  4415.  
  4416. function TBCTransformFilter.Stop: HRESULT;
  4417. begin
  4418.   FcsFilter.Lock;
  4419.   try
  4420.     if(FState = State_Stopped) then
  4421.     begin
  4422.       result := NOERROR;
  4423.       exit;
  4424.     end;
  4425.     // Succeed the Stop if we are not completely connected
  4426.     ASSERT((FInput = nil) or (FOutput <> nil));
  4427.     if((FInput = nil) or (FInput.IsConnected = FALSE) or (FOutput.IsConnected = FALSE)) then
  4428.     begin
  4429.       FState := State_Stopped;
  4430.       FEOSDelivered := FALSE;
  4431.       result := NOERROR;
  4432.       exit;
  4433.     end;
  4434.     ASSERT(FInput <> nil);
  4435.     ASSERT(FOutput <> nil);
  4436.     // decommit the input pin before locking or we can deadlock
  4437.     FInput.Inactive;
  4438.     // synchronize with Receive calls
  4439.     FcsReceive.Lock;
  4440.     try
  4441.       FOutput.Inactive;
  4442.       // allow a class derived from CTransformFilter
  4443.       // to know about starting and stopping streaming
  4444.       result := StopStreaming;
  4445.       if SUCCEEDED(result) then
  4446.       begin
  4447.         // complete the state transition
  4448.         FState := State_Stopped;
  4449.         FEOSDelivered := FALSE;
  4450.       end;
  4451.     finally
  4452.       FcsReceive.UnLock;
  4453.     end;
  4454.   finally
  4455.     FcsFilter.UnLock;
  4456.   end;
  4457. end;
  4458.  
  4459. function TBCTransformFilter.StopStreaming: HRESULT;
  4460. begin
  4461.   result := NOERROR;
  4462. end;
  4463.  
  4464. function TBCTransformFilter.Transform(msIn, msout: IMediaSample): HRESULT;
  4465. begin
  4466.   DbgLog(self, 'TBCTransformFilter.Transform should never be called');
  4467.   result := E_UNEXPECTED;
  4468. end;
  4469.  
  4470. { TBCTransformOutputPin }
  4471.  
  4472. // provides derived filter a chance to release it's extra interfaces
  4473.  
  4474. function TBCTransformOutputPin.BreakConnect: HRESULT;
  4475. begin
  4476.   //  Can't disconnect unless stopped
  4477.   ASSERT(IsStopped);
  4478.   FTransformFilter.BreakConnect(PINDIR_OUTPUT);
  4479.   result := inherited BreakConnect;
  4480. end;
  4481.  
  4482. // provides derived filter a chance to grab extra interfaces
  4483.  
  4484. function TBCTransformOutputPin.CheckConnect(Pin: IPin): HRESULT;
  4485. begin
  4486.   // we should have an input connection first
  4487.   ASSERT(FTransformFilter.FInput <> nil);
  4488.   if(FTransformFilter.FInput.IsConnected = FALSE) then
  4489.     begin
  4490.       result := E_UNEXPECTED;
  4491.       exit;
  4492.     end;
  4493.  
  4494.   result := FTransformFilter.CheckConnect(PINDIR_OUTPUT, Pin);
  4495.   if FAILED(result) then exit;
  4496.   result := inherited CheckConnect(Pin);
  4497. end;
  4498.  
  4499. // check a given transform - must have selected input type first
  4500.  
  4501. function TBCTransformOutputPin.CheckMediaType(
  4502.   mtOut: PAMMediaType): HRESULT;
  4503. begin
  4504.   // must have selected input first
  4505.   ASSERT(FTransformFilter.FInput <> nil);
  4506.   if(FTransformFilter.FInput.IsConnected = FALSE) then
  4507.     begin
  4508.       result := E_INVALIDARG;
  4509.       exit;
  4510.     end;
  4511.   result := FTransformFilter.CheckTransform(FTransformFilter.FInput.AMMediaType, mtOut);
  4512. end;
  4513.  
  4514. // Let derived class know when the output pin is connected
  4515.  
  4516. function TBCTransformOutputPin.CompleteConnect(ReceivePin: IPin): HRESULT;
  4517. begin
  4518.   result := FTransformFilter.CompleteConnect(PINDIR_OUTPUT, ReceivePin);
  4519.   if FAILED(result) then exit;
  4520.   result := inherited CompleteConnect(ReceivePin);
  4521. end;
  4522.  
  4523. constructor TBCTransformOutputPin.Create(ObjectName: string;
  4524.   TransformFilter: TBCTransformFilter; out hr: HRESULT; Name: WideString);
  4525. begin
  4526.   inherited create(ObjectName, TransformFilter, TransformFilter.FcsFilter, hr, Name);
  4527.   FPosition := nil;
  4528.   DbgLog(self, 'TBCTransformOutputPin.Create');
  4529.   FTransformFilter := TransformFilter;
  4530. end;
  4531.  
  4532. function TBCTransformOutputPin.DecideBufferSize(Alloc: IMemAllocator;
  4533.   Prop: PAllocatorProperties): HRESULT;
  4534. begin
  4535.   result := FTransformFilter.DecideBufferSize(Alloc, Prop);
  4536. end;
  4537.  
  4538. destructor TBCTransformOutputPin.destroy;
  4539. begin
  4540.   DbgLog(self, 'TBCTransformOutputPin.Destroy');
  4541.   FPosition := nil;
  4542.   inherited;
  4543. end;
  4544.  
  4545. function TBCTransformOutputPin.GetMediaType(Position: integer;
  4546.   out MediaType: PAMMediaType): HRESULT;
  4547. begin
  4548.   ASSERT(FTransformFilter.FInput <> nil);
  4549.   //  We don't have any media types if our input is not connected
  4550.   if(FTransformFilter.FInput.IsConnected) then
  4551.     begin
  4552.       result := FTransformFilter.GetMediaType(Position, MediaType);
  4553.       exit;
  4554.     end
  4555.   else
  4556.     result := VFW_S_NO_MORE_ITEMS;
  4557. end;
  4558.  
  4559. function TBCTransformOutputPin.NonDelegatingQueryInterface(
  4560.   const IID: TGUID; out Obj): HResult;
  4561. begin
  4562.   if IsEqualGUID(iid, IID_IMediaPosition) or IsEqualGUID(iid, IID_IMediaSeeking) then
  4563.     begin
  4564.       // we should have an input pin by now
  4565.       ASSERT(FTransformFilter.FInput <> nil);
  4566.       if (FPosition = nil) then
  4567.         begin
  4568.           result := CreatePosPassThru(GetOwner, FALSE, FTransformFilter.FInput, FPosition);
  4569.           if FAILED(result) then exit;
  4570.         end;
  4571.       result := FPosition.QueryInterface(iid, obj);
  4572.     end
  4573.   else
  4574.     result := inherited NonDelegatingQueryInterface(iid, obj);
  4575. end;
  4576.  
  4577. // Override this if you can do something constructive to act on the
  4578. // quality message.  Consider passing it upstream as well
  4579.  
  4580. // Pass the quality mesage on upstream.
  4581.  
  4582. function TBCTransformOutputPin.Notify(Sendr: IBaseFilter; q: TQuality): HRESULT;
  4583. begin
  4584.   // First see if we want to handle this ourselves
  4585.   result := FTransformFilter.AlterQuality(q);
  4586.   if (result <> S_FALSE) then exit;
  4587.   // S_FALSE means we pass the message on.
  4588.   // Find the quality sink for our input pin and send it there
  4589.   ASSERT(FTransformFilter.FInput <> nil);
  4590.   result := FTransformFilter.FInput.PassNotify(q);
  4591. end;
  4592.  
  4593. function TBCTransformOutputPin.QueryId(out Id: PWideChar): HRESULT;
  4594. begin
  4595.   result := AMGetWideString('Out', Id);
  4596. end;
  4597.  
  4598. // called after we have agreed a media type to actually set it in which case
  4599. // we run the CheckTransform function to get the output format type again
  4600.  
  4601. function TBCTransformOutputPin.SetMediaType(pmt: PAMMediaType): HRESULT;
  4602. begin
  4603.   ASSERT(FTransformFilter.FInput <> nil);
  4604.   ASSERT(not IsEqualGUID(FTransformFilter.FInput.AMMediaType.majortype,GUID_NULL));
  4605.   // Set the base class media type (should always succeed)
  4606.   result := inherited SetMediaType(pmt);
  4607.   if FAILED(result) then exit;
  4608. {$ifdef DEBUG}
  4609.   if(FAILED(FTransformFilter.CheckTransform(FTransformFilter.FInput.AMMediaType, pmt))) then
  4610.     begin
  4611.       DbgLog(self, '*** This filter is accepting an output media type');
  4612.       DbgLog(self, '    that it can''t currently transform to.  I hope');
  4613.       DbgLog(self, '    it''s smart enough to reconnect its input.');
  4614.     end;
  4615. {$endif}
  4616.   result := FTransformFilter.SetMediaType(PINDIR_OUTPUT,pmt);
  4617. end;
  4618.  
  4619. { TCTransInPlaceInputPin }
  4620.  
  4621. function TBCTransInPlaceInputPin.CheckMediaType(
  4622.   pmt: PAMMediaType): HRESULT;
  4623. begin
  4624.   result := FTIPFilter.CheckInputType(pmt);
  4625.   if (result <> S_OK) then exit;
  4626.   if FTIPFilter.FOutput.IsConnected then
  4627.     result := FTIPFilter.FOutput.GetConnected.QueryAccept(pmt^)
  4628.   else
  4629.     result := S_OK;
  4630. end;
  4631.  
  4632. function TBCTransInPlaceInputPin.EnumMediaTypes(
  4633.   out ppEnum: IEnumMediaTypes): HRESULT;
  4634. begin
  4635.   // Can only pass through if connected
  4636.   if (not FTIPFilter.FOutput.IsConnected) then
  4637.     begin
  4638.       result := VFW_E_NOT_CONNECTED;
  4639.       exit;
  4640.     end;
  4641.  
  4642.   result := FTIPFilter.FOutput.GetConnected.EnumMediaTypes(ppEnum);
  4643. end;
  4644.  
  4645. function TBCTransInPlaceInputPin.GetAllocator(
  4646.   out Allocator: IMemAllocator): HRESULT;
  4647. begin
  4648.   FLock.Lock;
  4649.   try
  4650.     if FTIPFilter.FOutput.IsConnected then
  4651.       begin
  4652.         //  Store the allocator we got
  4653.         result := FTIPFilter.OutputPin.ConnectedIMemInputPin.GetAllocator(Allocator);
  4654.         if SUCCEEDED(result) then
  4655.           FTIPFilter.OutputPin.SetAllocator(Allocator);
  4656.       end
  4657.     else
  4658.       begin
  4659.         //  Help upstream filter (eg TIP filter which is having to do a copy)
  4660.         //  by providing a temp allocator here - we'll never use
  4661.         //  this allocator because when our output is connected we'll
  4662.         //  reconnect this pin
  4663.         result := inherited GetAllocator(Allocator);
  4664.       end;
  4665.   finally
  4666.     FLock.UnLock;
  4667.   end;
  4668. end;
  4669.  
  4670. function TBCTransInPlaceInputPin.GetAllocatorRequirements(
  4671.   props: PAllocatorProperties): HRESULT;
  4672. begin
  4673.   if FTIPFilter.FOutput.IsConnected then
  4674.     result := FTIPFilter.OutputPin.ConnectedIMemInputPin.GetAllocatorRequirements(Props^)
  4675.   else
  4676.     result := E_NOTIMPL;
  4677. end;
  4678.  
  4679. function TBCTransInPlaceInputPin.NotifyAllocator(Allocator: IMemAllocator;
  4680.   ReadOnly: BOOL): HRESULT;
  4681. var
  4682.   OutputAllocator: IMemAllocator;
  4683.   Props, Actual: TAllocatorProperties;
  4684. begin
  4685.   result := S_OK;
  4686.   FLock.Lock;
  4687.   try
  4688.     FReadOnly := ReadOnly;
  4689.     //  If we modify data then don't accept the allocator if it's
  4690.     //  the same as the output pin's allocator
  4691.  
  4692.     //  If our output is not connected just accept the allocator
  4693.     //  We're never going to use this allocator because when our
  4694.     //  output pin is connected we'll reconnect this pin
  4695.     if not FTIPFilter.OutputPin.IsConnected then
  4696.       begin
  4697.         result := inherited NotifyAllocator(Allocator, ReadOnly);
  4698.         exit;
  4699.       end;
  4700.  
  4701.     //  If the allocator is read-only and we're modifying data
  4702.     //  and the allocator is the same as the output pin's
  4703.     //  then reject
  4704.     if (FReadOnly and FTIPFilter.FModifiesData) then
  4705.       begin
  4706.         OutputAllocator := FTIPFilter.OutputPin.PeekAllocator;
  4707.  
  4708.         //  Make sure we have an output allocator
  4709.         if (OutputAllocator = nil) then
  4710.         begin
  4711.           result := FTIPFilter.OutputPin.ConnectedIMemInputPin.GetAllocator(OutputAllocator);
  4712.           if FAILED(result) then result := CreateMemoryAllocator(OutputAllocator);
  4713.           if SUCCEEDED(result) then
  4714.             begin
  4715.               FTIPFilter.OutputPin.SetAllocator(OutputAllocator);
  4716.               OutputAllocator := nil;
  4717.             end;
  4718.         end;
  4719.         if (Allocator = OutputAllocator) then
  4720.           begin
  4721.             result := E_FAIL;
  4722.             exit;
  4723.           end
  4724.         else
  4725.           if SUCCEEDED(result) then
  4726.           begin
  4727.             //  Must copy so set the allocator properties on the output
  4728.             result := Allocator.GetProperties(Props);
  4729.             if SUCCEEDED(result) then
  4730.                result := OutputAllocator.SetProperties(Props, Actual);
  4731.             if SUCCEEDED(result) then
  4732.             begin
  4733.               if ((Props.cBuffers > Actual.cBuffers)
  4734.                   or (Props.cbBuffer > Actual.cbBuffer)
  4735.                   or (Props.cbAlign  > Actual.cbAlign)) then
  4736.                 result :=  E_FAIL;
  4737.  
  4738.             end;
  4739.  
  4740.             //  Set the allocator on the output pin
  4741.             if SUCCEEDED(result) then
  4742.               result := FTIPFilter.OutputPin.ConnectedIMemInputPin.NotifyAllocator(OutputAllocator, FALSE);
  4743.           end;
  4744.       end
  4745.     else
  4746.       begin
  4747.         result := FTIPFilter.OutputPin.ConnectedIMemInputPin.NotifyAllocator(Allocator, ReadOnly);
  4748.         if SUCCEEDED(result) then  FTIPFilter.OutputPin.SetAllocator(Allocator);
  4749.       end;
  4750.  
  4751.     if SUCCEEDED(result) then
  4752.     begin
  4753.       // It's possible that the old and the new are the same thing.
  4754.       // AddRef before release ensures that we don't unload it.
  4755.       Allocator._AddRef;
  4756.       if (FAllocator <> nil) then FAllocator := nil;
  4757.       Pointer(FAllocator) := Pointer(Allocator);    // We have an allocator for the input pin
  4758.     end;
  4759.   finally
  4760.     FLock.UnLock;
  4761.   end;
  4762. end;
  4763.  
  4764. function TBCTransInPlaceInputPin.PeekAllocator: IMemAllocator;
  4765. begin
  4766.  result := FAllocator;
  4767. end;
  4768.  
  4769. constructor TBCTransInPlaceInputPin.Create(ObjectName: string;
  4770.   Filter: TBCTransInPlaceFilter; out hr: HRESULT; Name: WideString);
  4771. begin
  4772.   inherited Create(ObjectName, Filter, hr, Name);
  4773.   FReadOnly := FALSE;
  4774.   FTIPFilter := Filter;
  4775.   DbgLog(self, 'TBCTransInPlaceInputPin.Create');
  4776. end;
  4777.  
  4778. { TBCTransInPlaceOutputPin }
  4779.  
  4780. function TBCTransInPlaceOutputPin.CheckMediaType(
  4781.   pmt: PAMMediaType): HRESULT;
  4782. begin
  4783.   // Don't accept any output pin type changes if we're copying
  4784.   // between allocators - it's too late to change the input
  4785.   // allocator size.
  4786.   if (FTIPFilter.UsingDifferentAllocators and (not FFilter.IsStopped)) then
  4787.   begin
  4788.     if TBCMediaType(pmt).Equal(@Fmt) then result := S_OK else result := VFW_E_TYPE_NOT_ACCEPTED;
  4789.     exit;
  4790.   end;
  4791.  
  4792.   // Assumes the type does not change.  That's why we're calling
  4793.   // CheckINPUTType here on the OUTPUT pin.
  4794.   result := FTIPFilter.CheckInputType(pmt);
  4795.   if (result <> S_OK) then exit;
  4796.   if (FTIPFilter.FInput.IsConnected) then
  4797.     result := FTIPFilter.FInput.GetConnected.QueryAccept(pmt^)
  4798.   else
  4799.     result := S_OK;
  4800. end;
  4801.  
  4802. function TBCTransInPlaceOutputPin.ConnectedIMemInputPin: IMemInputPin;
  4803. begin
  4804.   pointer(result) := pointer(FInputPin);
  4805. end;
  4806.  
  4807. constructor TBCTransInPlaceOutputPin.Create(ObjectName: string;
  4808.   Filter: TBCTransInPlaceFilter; out hr: HRESULT; Name: WideString);
  4809. begin
  4810.   inherited Create(ObjectName, Filter, hr, Name);
  4811.   FTIPFilter := Filter;
  4812.   DbgLog(self, 'TBCTransInPlaceOutputPin.Create');
  4813. end;
  4814.  
  4815. function TBCTransInPlaceOutputPin.EnumMediaTypes(
  4816.   out ppEnum: IEnumMediaTypes): HRESULT;
  4817. begin
  4818.   // Can only pass through if connected.
  4819.   if not FTIPFilter.FInput.IsConnected then
  4820.     result := VFW_E_NOT_CONNECTED
  4821.   else
  4822.     result := FTIPFilter.FInput.GetConnected.EnumMediaTypes(ppEnum);
  4823. end;
  4824.  
  4825. function TBCTransInPlaceOutputPin.PeekAllocator: IMemAllocator;
  4826. begin
  4827.   result := FAllocator;
  4828. end;
  4829.  
  4830. procedure TBCTransInPlaceOutputPin.SetAllocator(Allocator: IMemAllocator);
  4831. begin
  4832.     Allocator._AddRef;
  4833.     if(FAllocator <> nil) then  FAllocator._Release;
  4834.     Pointer(FAllocator) := Pointer(Allocator);
  4835. end;
  4836.  
  4837. { TBCTransInPlaceFilter }
  4838.  
  4839. function TBCTransInPlaceFilter.CheckTransform(mtIn,
  4840.   mtOut: PAMMediaType): HRESULT;
  4841. begin
  4842.   result := S_OK;
  4843. end;
  4844.  
  4845. // dir is the direction of our pin.
  4846. // pReceivePin is the pin we are connecting to.
  4847.  
  4848. function TBCTransInPlaceFilter.CompleteConnect(dir: TPinDirection;
  4849.   ReceivePin: IPin): HRESULT;
  4850. var
  4851.   pmt: PAMMediaType;
  4852. begin
  4853.   ASSERT(FInput <> nil);
  4854.   ASSERT(FOutput <> nil);
  4855.  
  4856.   // if we are not part of a graph, then don't indirect the pointer
  4857.   // this probably prevents use of the filter without a filtergraph
  4858.   if(FGraph = nil) then
  4859.   begin
  4860.     result := VFW_E_NOT_IN_GRAPH;
  4861.     exit;
  4862.   end;
  4863.  
  4864.   // Always reconnect the input to account for buffering changes
  4865.   //
  4866.   // Because we don't get to suggest a type on ReceiveConnection
  4867.   // we need another way of making sure the right type gets used.
  4868.   //
  4869.   // One way would be to have our EnumMediaTypes return our output
  4870.   // connection type first but more deterministic and simple is to
  4871.   // call ReconnectEx passing the type we want to reconnect with
  4872.   // via the base class ReconeectPin method.
  4873.  
  4874.   if(dir = PINDIR_OUTPUT) then
  4875.   begin
  4876.     if FInput.IsConnected then
  4877.     begin
  4878.       result := ReconnectPin(FInput, FOutput.AMMediaType);
  4879.       exit;
  4880.     end;
  4881.     result := NOERROR;
  4882.     exit;
  4883.   end;
  4884.  
  4885.   ASSERT(dir = PINDIR_INPUT);
  4886.  
  4887.   // Reconnect output if necessary
  4888.  
  4889.   if FOutput.IsConnected then
  4890.   begin
  4891.     pmt := FInput.CurrentMediaType.MediaType;
  4892.     if (not TBCMediaType(pmt).Equal(FOutput.CurrentMediaType.MediaType)) then
  4893.     begin
  4894.       result := ReconnectPin(FOutput, FInput.CurrentMediaType.MediaType);
  4895.       exit;
  4896.     end;
  4897.   end;
  4898.   result := NOERROR;
  4899. end;
  4900.  
  4901. function TBCTransInPlaceFilter.Copy(Source: IMediaSample): IMediaSample;
  4902. var
  4903.   Start, Stop: TReferenceTime;
  4904.   Time: boolean;
  4905.   pStartTime, pEndTime: PReferenceTime;
  4906.   TimeStart, TimeEnd: Int64;
  4907.   Flags: DWORD;
  4908.   Sample2: IMediaSample2;
  4909.   props: PAMSample2Properties;
  4910.   MediaType: PAMMediaType;
  4911.   DataLength: LongInt;
  4912.   SourceBuffer, DestBuffer: PByte;
  4913.   SourceSize, DestSize: LongInt;
  4914.   hr: hresult;
  4915. begin
  4916.     Time := (Source.GetTime(Start, Stop) = S_OK);
  4917.     // this may block for an indeterminate amount of time
  4918.     if Time then
  4919.       begin
  4920.         pStartTime := @Start;
  4921.         pEndTime   := @Stop;
  4922.       end
  4923.     else
  4924.       begin
  4925.         pStartTime := nil;
  4926.         pEndTime   := nil;
  4927.       end;
  4928.     if FSampleSkipped then Flags := AM_GBF_PREVFRAMESKIPPED else Flags := 0;
  4929.     hr := OutputPin.PeekAllocator.GetBuffer(result, pStartTime, pEndTime, Flags);
  4930.  
  4931.     if FAILED(hr) then exit;
  4932.  
  4933.     ASSERT(result <> nil);
  4934.     if(SUCCEEDED(result.QueryInterface(IID_IMediaSample2, Sample2))) then
  4935.       begin
  4936.         props :=  FInput.SampleProps;
  4937.         hr := Sample2.SetProperties(SizeOf(TAMSample2Properties) - (4*2), props^);
  4938.         Sample2 := nil;
  4939.         if FAILED(hr) then
  4940.         begin
  4941.           result := nil;
  4942.           exit;
  4943.         end;
  4944.       end
  4945.     else
  4946.       begin
  4947.         if Time then result.SetTime(@Start, @Stop);
  4948.         if (Source.IsSyncPoint = S_OK) then result.SetSyncPoint(TRUE);
  4949.         if ((Source.IsDiscontinuity = S_OK) or FSampleSkipped) then result.SetDiscontinuity(TRUE);
  4950.         if (Source.IsPreroll = S_OK) then result.SetPreroll(TRUE);
  4951.         // Copy the media type
  4952.         if (Source.GetMediaType(MediaType) = S_OK) then
  4953.           begin
  4954.             result.SetMediaType(MediaType^);
  4955.             DeleteMediaType(MediaType);
  4956.           end;
  4957.  
  4958.       end;
  4959.  
  4960.     FSampleSkipped := FALSE;
  4961.  
  4962.     // Copy the sample media times
  4963.     if (Source.GetMediaTime(TimeStart, TimeEnd) = NOERROR) then
  4964.       result.SetMediaTime(@TimeStart,@TimeEnd);
  4965.  
  4966.     // Copy the actual data length and the actual data.
  4967.     DataLength := Source.GetActualDataLength;
  4968.  
  4969.     result.SetActualDataLength(DataLength);
  4970.  
  4971.     // Copy the sample data
  4972.     SourceSize := Source.GetSize;
  4973.     DestSize   := result.GetSize;
  4974. {$IFDEF DEBUG}
  4975.     DebugLog.SaveToFile('c:\BaseClass.txt');
  4976. {$ENDIF}
  4977.     ASSERT(DestSize >= SourceSize, format('DestSize (%d) < SourceSize (%d)',[DestSize, SourceSize]));
  4978.     ASSERT(DestSize >= DataLength);
  4979.  
  4980.     Source.GetPointer(SourceBuffer);
  4981.     result.GetPointer(DestBuffer);
  4982.     ASSERT((DestSize = 0) or (SourceBuffer <> nil) and (DestBuffer <> nil));
  4983.     CopyMemory(DestBuffer, SourceBuffer, DataLength);
  4984. end;
  4985.  
  4986. constructor TBCTransInPlaceFilter.Create(ObjectName: string;
  4987.   unk: IUnKnown; clsid: TGUID; out hr: HRESULT; ModifiesData: boolean);
  4988. begin
  4989.   inherited create(ObjectName, Unk, clsid);
  4990.   FModifiesData := ModifiesData;
  4991. end;
  4992.  
  4993. constructor TBCTransInPlaceFilter.CreateFromFactory(Factory: TBCClassFactory;
  4994.   const Controller: IUnknown);
  4995. begin
  4996.   inherited create(FacTory.FName, Controller, FacTory.FClassID);
  4997.   FModifiesData := True;
  4998. end;
  4999.  
  5000. // Tell the output pin's allocator what size buffers we require.
  5001. // *pAlloc will be the allocator our output pin is using.
  5002.  
  5003. function TBCTransInPlaceFilter.DecideBufferSize(Alloc: IMemAllocator;
  5004.   propInputRequest: PAllocatorProperties): HRESULT;
  5005. var Request, Actual: TAllocatorProperties;
  5006. begin
  5007.   // If we are connected upstream, get his views
  5008.   if FInput.IsConnected then
  5009.     begin
  5010.       // Get the input pin allocator, and get its size and count.
  5011.       // we don't care about his alignment and prefix.
  5012.       result := InputPin.FAllocator.GetProperties(Request);
  5013.       //Request.cbBuffer := 230400;
  5014.       if FAILED(result) then exit; // Input connected but with a secretive allocator - enough!
  5015.     end
  5016.   else
  5017.     begin
  5018.       // We're reduced to blind guessing.  Let's guess one byte and if
  5019.       // this isn't enough then when the other pin does get connected
  5020.       // we can revise it.
  5021.       ZeroMemory(@Request, sizeof(Request));
  5022.       Request.cBuffers := 1;
  5023.       Request.cbBuffer := 1;
  5024.     end;
  5025.  
  5026.  
  5027.   DbgLog(self, 'Setting Allocator Requirements');
  5028.   DbgLog(self, format('Count %d, Size %d',[Request.cBuffers, Request.cbBuffer]));
  5029.  
  5030.   // Pass the allocator requirements to our output side
  5031.   // but do a little sanity checking first or we'll just hit
  5032.   // asserts in the allocator.
  5033.  
  5034.   propInputRequest.cBuffers := Request.cBuffers;
  5035.   propInputRequest.cbBuffer := Request.cbBuffer;
  5036.   if (propInputRequest.cBuffers <= 0) then propInputRequest.cBuffers := 1;
  5037.   if (propInputRequest.cbBuffer <= 0) then propInputRequest.cbBuffer := 1;
  5038.   result := Alloc.SetProperties(propInputRequest^, Actual);
  5039.   if FAILED(result) then exit;
  5040.  
  5041.   DbgLog(self, 'Obtained Allocator Requirements');
  5042.   DbgLog(self, format('Count %d, Size %d, Alignment %d', [Actual.cBuffers, Actual.cbBuffer, Actual.cbAlign]));
  5043.  
  5044.   // Make sure we got the right alignment and at least the minimum required
  5045.  
  5046.   if ((Request.cBuffers > Actual.cBuffers)
  5047.       or (Request.cbBuffer > Actual.cbBuffer)
  5048.       or (Request.cbAlign  > Actual.cbAlign)) then
  5049.     result := E_FAIL
  5050.   else
  5051.     result := NOERROR;
  5052. end;
  5053.  
  5054. function TBCTransInPlaceFilter.GetMediaType(Position: integer;
  5055.   out MediaType: PAMMediaType): HRESULT;
  5056. begin
  5057.   DbgLog(self, 'TBCTransInPlaceFilter.GetMediaType should never be called');
  5058.   result := E_UNEXPECTED;
  5059. end;
  5060.  
  5061. // return a non-addrefed CBasePin * for the user to addref if he holds onto it
  5062. // for longer than his pointer to us. We create the pins dynamically when they
  5063. // are asked for rather than in the constructor. This is because we want to
  5064. // give the derived class an oppportunity to return different pin objects
  5065.  
  5066. // As soon as any pin is needed we create both (this is different from the
  5067. // usual transform filter) because enumerators, allocators etc are passed
  5068. // through from one pin to another and it becomes very painful if the other
  5069. // pin isn't there.  If we fail to create either pin we ensure we fail both.
  5070.  
  5071. function TBCTransInPlaceFilter.GetPin(n: integer): TBCBasePin;
  5072. var hr: HRESULT;
  5073. begin
  5074.   hr := S_OK;
  5075.   // Create an input pin if not already done
  5076.   if(FInput = nil) then
  5077.   begin
  5078.     FInput := TBCTransInPlaceInputPin.Create('TransInPlace input pin',
  5079.       self,      // Owner filter
  5080.       hr,        // Result code
  5081.       'Input');  // Pin name
  5082.  
  5083.     // Constructor for CTransInPlaceInputPin can't fail
  5084.     ASSERT(SUCCEEDED(hr));
  5085.   end;
  5086.  
  5087.   // Create an output pin if not already done
  5088.  
  5089.   if((FInput <> nil) and (FOutput = nil)) then
  5090.   begin
  5091.     FOutput := TBCTransInPlaceOutputPin.Create('TransInPlace output pin',
  5092.       self,      // Owner filter
  5093.       hr,        // Result code
  5094.       'Output'); // Pin name
  5095.  
  5096.     // a failed return code should delete the object
  5097.     ASSERT(SUCCEEDED(hr));
  5098.       if(FOutput = nil) then
  5099.       begin
  5100.         FInput.Free;
  5101.         FInput := nil;
  5102.       end;
  5103.   end;
  5104.  
  5105.   // Return the appropriate pin
  5106.  
  5107.   ASSERT(n in [0,1]);
  5108.   case n of
  5109.     0: result := FInput;
  5110.     1: result := FOutput;
  5111.   else
  5112.     result := nil;
  5113.   end;
  5114. end;
  5115.  
  5116. function TBCTransInPlaceFilter.InputPin: TBCTransInPlaceInputPin;
  5117. begin
  5118.   result := TBCTransInPlaceInputPin(FInput);
  5119. end;
  5120.  
  5121. function TBCTransInPlaceFilter.OutputPin: TBCTransInPlaceOutputPin;
  5122. begin
  5123.   result := TBCTransInPlaceOutputPin(FOutput);
  5124. end;
  5125.  
  5126. function TBCTransInPlaceFilter.Receive(Sample: IMediaSample): HRESULT;
  5127. var Props: PAMSample2Properties;
  5128. begin
  5129.   //  Check for other streams and pass them on */
  5130.   Props := FInput.SampleProps;
  5131.   if (Props.dwStreamId <> AM_STREAM_MEDIA) then
  5132.     begin
  5133.       result := FOutput.Deliver(Sample);
  5134.       exit;
  5135.     end;
  5136.  
  5137.   if UsingDifferentAllocators then
  5138.   begin
  5139.     // We have to copy the data.
  5140.     Sample := Copy(Sample);
  5141.     if (Sample = nil) then
  5142.     begin
  5143.       result := E_UNEXPECTED;
  5144.       exit;
  5145.     end;
  5146.   end;
  5147.  
  5148.   // have the derived class transform the data
  5149.   result := Transform(Sample);
  5150.  
  5151.   if FAILED(result) then
  5152.   begin
  5153.     DbgLog(self, 'Error from TransInPlace');
  5154.     if UsingDifferentAllocators then Sample := nil;
  5155.     exit;
  5156.   end;
  5157.  
  5158.   // the Transform() function can return S_FALSE to indicate that the
  5159.   // sample should not be delivered; we only deliver the sample if it's
  5160.   // really S_OK (same as NOERROR, of course.)
  5161.   if (result = NOERROR) then
  5162.     result := FOutput.Deliver(Sample)
  5163.   else
  5164.     begin
  5165.       //  But it would be an error to return this private workaround
  5166.       //  to the caller ...
  5167.       if (result = S_FALSE) then
  5168.       begin
  5169.         // S_FALSE returned from Transform is a PRIVATE agreement
  5170.         // We should return NOERROR from Receive() in this cause because
  5171.         // returning S_FALSE from Receive() means that this is the end
  5172.         // of the stream and no more data should be sent.
  5173.         FSampleSkipped := TRUE;
  5174.         if (not FQualityChanged) then
  5175.         begin
  5176.           NotifyEvent(EC_QUALITY_CHANGE,0,0);
  5177.           FQualityChanged := TRUE;
  5178.         end;
  5179.         result := NOERROR;
  5180.       end;
  5181.     end;
  5182.  
  5183.   // release the output buffer. If the connected pin still needs it,
  5184.   // it will have addrefed it itself.
  5185.   if UsingDifferentAllocators then Sample := nil;
  5186. end;
  5187.  
  5188. function TBCTransInPlaceFilter.TypesMatch: boolean;
  5189. var
  5190.   pmt: PAMMediaType;
  5191. begin
  5192.   pmt := InputPin.CurrentMediaType.MediaType;
  5193.   result := TBCMediaType(pmt).Equal(OutputPin.CurrentMediaType.MediaType);
  5194. end;
  5195.  
  5196. function TBCTransInPlaceFilter.UsingDifferentAllocators: boolean;
  5197. begin
  5198.   result := Pointer(InputPin.FAllocator) <> Pointer(OutputPin.FAllocator);
  5199. end;
  5200.  
  5201. { TBCBasePropertyPage }
  5202.  
  5203. function TBCBasePropertyPage.Activate(hwndParent: HWnd; const rc: TRect;
  5204.   bModal: BOOL): HResult;
  5205. begin
  5206.   // Return failure if SetObject has not been called.
  5207.   if (FObjectSet = FALSE) or (hwndParent = 0) then
  5208.     begin
  5209.       result := E_UNEXPECTED;
  5210.       exit;
  5211.     end;
  5212.  
  5213.    // FForm := TCustomFormClass(FFormClass).Create(nil);
  5214.  
  5215.     if (FForm = nil) then
  5216.       begin
  5217.         result := E_OUTOFMEMORY;
  5218.         exit;
  5219.       end;
  5220.  
  5221.     FForm.ParentWindow := hwndParent;
  5222.     if assigned(FForm.OnActivate) then FForm.OnActivate(FForm);
  5223.     Move(rc);
  5224.     result := Show(SW_SHOWNORMAL);
  5225. end;
  5226.  
  5227. function TBCBasePropertyPage.Apply: HResult;
  5228. begin
  5229.   // In ActiveMovie 1.0 we used to check whether we had been activated or
  5230.   // not. This is too constrictive. Apply should be allowed as long as
  5231.   // SetObject was called to set an object. So we will no longer check to
  5232.   // see if we have been activated (ie., m_hWnd != NULL), but instead
  5233.   // make sure that m_bObjectSet is TRUE (ie., SetObject has been called).
  5234.  
  5235.   if (FObjectSet = FALSE) or (FPageSite = nil) then
  5236.   begin
  5237.     result := E_UNEXPECTED;
  5238.     exit;
  5239.   end;
  5240.  
  5241.   if (FDirty = FALSE) then
  5242.   begin
  5243.     result := NOERROR;
  5244.     exit;
  5245.   end;
  5246.  
  5247.   // Commit derived class changes
  5248.  
  5249.   result := FForm.OnApplyChanges;
  5250.   if SUCCEEDED(result) then FDirty := FALSE;
  5251. end;
  5252.  
  5253. function TBCBasePropertyPage.Deactivate: HResult;
  5254. var Style: DWORD;
  5255. begin
  5256.     if (FForm = nil) then
  5257.     begin
  5258.       result := E_UNEXPECTED;
  5259.       exit;
  5260.     end;
  5261.  
  5262.     // Remove WS_EX_CONTROLPARENT before DestroyWindow call
  5263.  
  5264.     Style := GetWindowLong(FForm.Handle, GWL_EXSTYLE);
  5265.     Style := Style and (not WS_EX_CONTROLPARENT);
  5266.  
  5267.     //  Set m_hwnd to be NULL temporarily so the message handler
  5268.     //  for WM_STYLECHANGING doesn't add the WS_EX_CONTROLPARENT
  5269.     //  style back in
  5270.  
  5271.     SetWindowLong(FForm.Handle, GWL_EXSTYLE, Style);
  5272.     if assigned(FForm.OnDeactivate) then FForm.OnDeactivate(FForm);
  5273.  
  5274.     // Destroy the dialog window
  5275.  
  5276.     //FForm.Free;
  5277.     //FForm := nil;
  5278.     result := NOERROR;
  5279. end;
  5280.  
  5281. function TBCBasePropertyPage.GetPageInfo(out pageInfo: TPropPageInfo): HResult;
  5282. begin
  5283.   pageInfo.cb := sizeof(TPropPageInfo);
  5284.   AMGetWideString(FForm.Caption, pageInfo.pszTitle);
  5285.   PageInfo.pszDocString := nil;
  5286.   PageInfo.pszHelpFile  := nil;
  5287.   PageInfo.dwHelpContext:= 0;
  5288.   PageInfo.size.cx := FForm.width;
  5289.   PageInfo.size.cy := FForm.Height;
  5290.   Result := NoError;
  5291. end;
  5292.  
  5293. function TBCBasePropertyPage.Help(pszHelpDir: POleStr): HResult;
  5294. begin
  5295.   result := E_NOTIMPL;
  5296. end;
  5297.  
  5298. function TBCBasePropertyPage.IsPageDirty: HResult;
  5299. begin
  5300.   if FDirty then result := S_OK else result := S_FALSE; 
  5301. end;
  5302.  
  5303. function TBCBasePropertyPage.Move(const rect: TRect): HResult;
  5304. begin
  5305.   if (FForm = nil) then
  5306.   begin
  5307.     result := E_UNEXPECTED;
  5308.     exit;
  5309.   end;
  5310.  
  5311.   MoveWindow(FForm.Handle,             // Property page handle
  5312.                Rect.left,              // x coordinate
  5313.                Rect.top,               // y coordinate
  5314.                Rect.Right - Rect.Left, // Overall window width
  5315.                Rect.Bottom - Rect.Top, // And likewise height
  5316.                TRUE);                  // Should we repaint it
  5317.  
  5318.   result := NOERROR;
  5319. end;
  5320.  
  5321. function TBCBasePropertyPage.SetObjects(cObjects: Integer;
  5322.   pUnkList: PUnknownList): HResult;
  5323. begin
  5324.   if (cObjects = 1) then
  5325.     begin
  5326.       if (pUnkList = nil) then
  5327.       begin
  5328.         result := E_POINTER;
  5329.         exit;
  5330.       end;
  5331.       // Set a flag to say that we have set the Object
  5332.       FObjectSet := TRUE ;
  5333.       result := FForm.OnConnect(pUnkList^[0]);
  5334.       exit;
  5335.      end
  5336.    else
  5337.      if (cObjects = 0) then
  5338.      begin
  5339.        // Set a flag to say that we have not set the Object for the page
  5340.        FObjectSet := FALSE;
  5341.        result := FForm.OnDisconnect;
  5342.        exit;
  5343.      end;
  5344.  
  5345.     DbgLog(self, 'No support for more than one object');
  5346.     result := E_UNEXPECTED;
  5347. end;
  5348.  
  5349. function TBCBasePropertyPage.SetPageSite(
  5350.   const pageSite: IPropertyPageSite): HResult;
  5351. begin
  5352.   if (pageSite <> nil) then
  5353.     begin
  5354.       if (FPageSite <> nil) then
  5355.       begin
  5356.         result := E_UNEXPECTED;
  5357.         exit;
  5358.       end;
  5359.       FPageSite := pageSite;
  5360.     end
  5361.   else
  5362.     begin
  5363.       if (FPageSite = nil) then
  5364.       begin
  5365.         result := E_UNEXPECTED;
  5366.         exit;
  5367.       end;
  5368.       FPageSite := nil;
  5369.     end;
  5370.   result := NOERROR;
  5371. end;
  5372.  
  5373. function TBCBasePropertyPage.Show(nCmdShow: Integer): HResult;
  5374. begin
  5375.   if (FForm = nil) then
  5376.   begin
  5377.     result := E_UNEXPECTED;
  5378.     exit;
  5379.   end;
  5380.  
  5381.   if ((nCmdShow <> SW_SHOW) and (nCmdShow <> SW_SHOWNORMAL) and (nCmdShow <> SW_HIDE)) then
  5382.     begin
  5383.       result := E_INVALIDARG;
  5384.       exit;
  5385.     end;
  5386.  
  5387.     if nCmdShow in [SW_SHOW,SW_SHOWNORMAL] then FForm.Show else FForm.Hide;
  5388.     InvalidateRect(FForm.Handle, nil, TRUE);
  5389.     result := NOERROR;
  5390. end;
  5391.  
  5392. function TBCBasePropertyPage.TranslateAccelerator(msg: PMsg): HResult;
  5393. begin
  5394.   result := E_NOTIMPL;
  5395. end;
  5396.  
  5397. constructor TBCBasePropertyPage.Create(Name: String; Unk: IUnKnown; Form: TFormPropertyPage);
  5398. begin
  5399.   inherited Create(Name, Unk);
  5400.   FForm := Form;
  5401.   FForm.BorderStyle := bsNone;
  5402.   FPageSite  := nil;
  5403.   FObjectSet := false;
  5404.   FDirty     := false;
  5405. end;
  5406.  
  5407. destructor TBCBasePropertyPage.Destroy;
  5408. begin
  5409.   if FForm <> nil then
  5410.     begin
  5411.       FForm.Free;
  5412.       FForm := nil;
  5413.     end;
  5414.   inherited;
  5415. end;
  5416.  
  5417. function TFormPropertyPage.OnApplyChanges: HRESULT;
  5418. begin
  5419.   result := NOERROR;
  5420. end;
  5421.  
  5422. function TFormPropertyPage.OnConnect(Unknown: IUnKnown): HRESULT;
  5423. begin
  5424.   result := NOERROR;
  5425. end;
  5426.  
  5427. function TFormPropertyPage.OnDisconnect: HRESULT;
  5428. begin
  5429.   result := NOERROR;
  5430. end;
  5431.  
  5432. procedure TBCBasePropertyPage.SetPageDirty;
  5433. begin
  5434.   FDirty := True;
  5435. end;
  5436.  
  5437. { TBCBaseDispatch }
  5438.  
  5439. function TBCBaseDispatch.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  5440.   NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
  5441. var ti: ITypeInfo;
  5442. begin
  5443.   // although the IDispatch riid is dead, we use this to pass from
  5444.   // the interface implementation class to us the iid we are talking about.
  5445.   result := GetTypeInfo(iid, 0, LocaleID, ti);
  5446.   if SUCCEEDED(result) then
  5447.     result := ti.GetIDsOfNames(Names, NameCount, DispIDs);
  5448. end;
  5449.  
  5450. function TBCBaseDispatch.GetTypeInfo(const iid: TGUID; info: Cardinal; lcid: LCID;
  5451.   out tinfo): HRESULT; stdcall;
  5452. var
  5453.   tlib : ITypeLib;
  5454. begin
  5455.   // we only support one type element
  5456.   if (info <> 0) then
  5457.     begin
  5458.       result := TYPE_E_ELEMENTNOTFOUND;
  5459.       exit;
  5460.     end;
  5461.  
  5462.   // always look for neutral
  5463.   if (FTI = nil) then
  5464.   begin
  5465.     result := LoadRegTypeLib(LIBID_QuartzTypeLib, 1, 0, lcid, tlib);
  5466.     if FAILED(result) then
  5467.     begin
  5468.       result := LoadTypeLib('control.tlb', tlib);
  5469.       if FAILED(result) then exit;
  5470.     end;
  5471.     result := tlib.GetTypeInfoOfGuid(iid, Fti);
  5472.     tlib := nil;
  5473.     if FAILED(result) then exit;
  5474.   end;
  5475.   ITypeInfo(tinfo) := Fti;
  5476.   result := S_OK;
  5477. end;
  5478.  
  5479. function TBCBaseDispatch.GetTypeInfoCount(out Count: Integer): HResult;
  5480. begin
  5481.   count := 1;
  5482.   result := S_OK;
  5483. end;
  5484.  
  5485. { TBCMediaControl }
  5486.  
  5487. constructor TBCMediaControl.Create(name: string; unk: IUnknown);
  5488. begin
  5489.   FBaseDisp := TBCBaseDispatch.Create;
  5490. end;
  5491.  
  5492. destructor TBCMediaControl.Destroy;
  5493. begin
  5494.   FBaseDisp.Free;
  5495.   inherited;
  5496. end;
  5497.  
  5498. function TBCMediaControl.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  5499.   NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
  5500. begin
  5501.   result := FBasedisp.GetIDsOfNames(IID_IMediaControl, Names, NameCount, LocaleID, DispIDs);
  5502. end;
  5503.  
  5504. function TBCMediaControl.GetTypeInfo(Index, LocaleID: Integer;
  5505.   out TypeInfo): HResult;
  5506. begin
  5507.   result := Fbasedisp.GetTypeInfo(IID_IMediaControl, index, LocaleID, TypeInfo);
  5508. end;
  5509.  
  5510. function TBCMediaControl.GetTypeInfoCount(out Count: Integer): HResult;
  5511. begin
  5512.   result := FBaseDisp.GetTypeInfoCount(Count);
  5513. end;
  5514.  
  5515. function TBCMediaControl.Invoke(DispID: Integer; const IID: TGUID;
  5516.   LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  5517.   ArgErr: Pointer): HResult;
  5518. var ti: ITypeInfo;
  5519. begin
  5520.   // this parameter is a dead leftover from an earlier interface
  5521.   if not IsEqualGUID(GUID_NULL, IID) then
  5522.     begin
  5523.       result := DISP_E_UNKNOWNINTERFACE;
  5524.       exit;
  5525.     end;
  5526.   result := GetTypeInfo(0, LocaleID, ti);
  5527.   if FAILED(result) then exit;
  5528.   result := ti.Invoke(Pointer(Integer(Self)), DISPID, Flags, TDispParams(Params),
  5529.     VarResult, ExcepInfo, ArgErr);
  5530. end;
  5531.  
  5532. { TBCMediaEvent }
  5533.  
  5534. constructor TBCMediaEvent.Create(Name: string; Unk: IUnknown);
  5535. begin
  5536.   inherited Create(name, Unk);
  5537.   FBasedisp := TBCBaseDispatch.Create;
  5538. end;
  5539.  
  5540. destructor TBCMediaEvent.destroy;
  5541. begin
  5542.   FBasedisp.Free;
  5543.   inherited;
  5544. end;
  5545.  
  5546. function TBCMediaEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  5547.   NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
  5548. begin
  5549.   result := FBasedisp.GetIDsOfNames(IID_IMediaEvent, Names, NameCount, LocaleID, DispIDs);
  5550. end;
  5551.  
  5552. function TBCMediaEvent.GetTypeInfo(Index, LocaleID: Integer;
  5553.   out TypeInfo): HResult;
  5554. begin
  5555.   result := Fbasedisp.GetTypeInfo(IID_IMediaEvent, index, LocaleID, TypeInfo);
  5556. end;
  5557.  
  5558. function TBCMediaEvent.GetTypeInfoCount(out Count: Integer): HResult;
  5559. begin
  5560.   result := FBaseDisp.GetTypeInfoCount(Count);
  5561. end;
  5562.  
  5563. function TBCMediaEvent.Invoke(DispID: Integer; const IID: TGUID;
  5564.   LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  5565.   ArgErr: Pointer): HResult;
  5566. var ti: ITypeInfo;
  5567. begin
  5568.   // this parameter is a dead leftover from an earlier interface
  5569.   if not IsEqualGUID(GUID_NULL, IID) then
  5570.     begin
  5571.       result := DISP_E_UNKNOWNINTERFACE;
  5572.       exit;
  5573.     end;
  5574.   result := GetTypeInfo(0, LocaleID, ti);
  5575.   if FAILED(result) then exit;
  5576.   result := ti.Invoke(Pointer(Integer(Self)), DISPID, Flags, TDispParams(Params), VarResult, ExcepInfo, ArgErr);
  5577. end;
  5578.  
  5579. { TBCMediaPosition }
  5580.  
  5581. constructor TBCMediaPosition.Create(Name: String; Unk: IUnknown);
  5582. begin
  5583.   inherited Create(Name, Unk);
  5584.   FBaseDisp := TBCBaseDispatch.Create;
  5585. end;
  5586.  
  5587. constructor TBCMediaPosition.Create(Name: String; Unk: IUnknown;
  5588.   out hr: HRESULT);
  5589. begin
  5590.   inherited Create(Name, Unk);
  5591.   FBaseDisp := TBCBaseDispatch.Create;
  5592. end;
  5593.  
  5594. destructor TBCMediaPosition.Destroy;
  5595. begin
  5596.   FBaseDisp.Free;
  5597.   inherited;
  5598. end;
  5599.  
  5600. function TBCMediaPosition.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  5601.   NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
  5602. begin
  5603.   result := FBasedisp.GetIDsOfNames(IID_IMediaPosition, Names, NameCount, LocaleID, DispIDs);
  5604. end;
  5605.  
  5606. function TBCMediaPosition.GetTypeInfo(Index, LocaleID: Integer;
  5607.   out TypeInfo): HResult;
  5608. begin
  5609.   result := Fbasedisp.GetTypeInfo(IID_IMediaPosition, index, LocaleID, TypeInfo);
  5610. end;
  5611.  
  5612. function TBCMediaPosition.GetTypeInfoCount(out Count: Integer): HResult;
  5613. begin
  5614.   result := Fbasedisp.GetTypeInfoCount(Count);
  5615. end;
  5616.  
  5617. function TBCMediaPosition.Invoke(DispID: Integer; const IID: TGUID;
  5618.   LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  5619.   ArgErr: Pointer): HResult;
  5620. var ti: ITypeInfo;
  5621. begin
  5622.   // this parameter is a dead leftover from an earlier interface
  5623.   if not IsEqualGUID(GUID_NULL, IID) then
  5624.     begin
  5625.       result := DISP_E_UNKNOWNINTERFACE;
  5626.       exit;
  5627.     end;
  5628.   result := GetTypeInfo(0, LocaleID, ti);
  5629.   if FAILED(result) then exit;
  5630.   result := ti.Invoke(Pointer(Integer(Self)), DISPID, Flags, TDispParams(Params), VarResult, ExcepInfo, ArgErr);
  5631. end;
  5632.  
  5633. { TBCPosPassThru }
  5634.  
  5635. function TBCPosPassThru.CanSeekBackward(
  5636.   out pCanSeekBackward: Integer): HResult;
  5637. var MP: IMediaPosition;
  5638. begin
  5639.   result := GetPeer(MP);
  5640.   if FAILED(result) then exit;
  5641.   result := MP.CanSeekBackward(pCanSeekBackward);
  5642. end;
  5643.  
  5644. function TBCPosPassThru.CanSeekForward(
  5645.   out pCanSeekForward: Integer): HResult;
  5646. var MP: IMediaPosition;
  5647. begin
  5648.   result := GetPeer(MP);
  5649.   if FAILED(result) then exit;
  5650.   result := MP.CanSeekForward(pCanSeekForward);
  5651. end;
  5652.  
  5653. function TBCPosPassThru.CheckCapabilities(
  5654.   var pCapabilities: DWORD): HRESULT;
  5655. var
  5656.   MS: IMediaSeeking;
  5657. begin
  5658.   result := GetPeerSeeking(MS);
  5659.   if FAILED(result) then exit;
  5660.   result := MS.CheckCapabilities(pCapabilities);
  5661. end;
  5662.  
  5663. function TBCPosPassThru.ConvertTimeFormat(out pTarget: int64;
  5664.   pTargetFormat: PGUID; Source: int64; pSourceFormat: PGUID): HRESULT;
  5665. var MS: IMediaSeeking;
  5666. begin
  5667.   result := GetPeerSeeking(MS);
  5668.   if FAILED(result) then exit;
  5669.   result := MS.ConvertTimeFormat(pTarget, pTargetFormat, Source, pSourceFormat);
  5670. end;
  5671.  
  5672. constructor TBCPosPassThru.Create(name: String; Unk: IUnknown;
  5673.   out hr: HRESULT; Pin: IPin);
  5674. begin
  5675.   assert(Pin <> nil);
  5676.   inherited Create(Name,Unk);
  5677.   FPin := Pin;
  5678. end;
  5679.  
  5680. function TBCPosPassThru.ForceRefresh: HRESULT;
  5681. begin
  5682.   result := S_OK;
  5683. end;
  5684.  
  5685. function TBCPosPassThru.get_CurrentPosition(
  5686.   out pllTime: TRefTime): HResult;
  5687. var MP: IMediaPosition;
  5688. begin
  5689.   result := GetPeer(MP);
  5690.   if FAILED(result) then exit;
  5691.   result := MP.get_CurrentPosition(pllTime);
  5692. end;
  5693.  
  5694. function TBCPosPassThru.get_Duration(out plength: TRefTime): HResult;
  5695. var MP: IMediaPosition;
  5696. begin
  5697.   result := GetPeer(MP);
  5698.   if FAILED(result) then exit;
  5699.   result := MP.get_Duration(plength);
  5700. end;
  5701.  
  5702. function TBCPosPassThru.get_PrerollTime(out pllTime: TRefTime): HResult;
  5703. var MP: IMediaPosition;
  5704. begin
  5705.   result := GetPeer(MP);
  5706.   if FAILED(result) then exit;
  5707.   result := MP.get_PrerollTime(pllTime);
  5708. end;
  5709.  
  5710. function TBCPosPassThru.get_Rate(out pdRate: double): HResult;
  5711. var MP: IMediaPosition;
  5712. begin
  5713.   result := GetPeer(MP);
  5714.   if FAILED(result) then exit;
  5715.   result := MP.get_Rate(pdRate);
  5716. end;
  5717.  
  5718. function TBCPosPassThru.get_StopTime(out pllTime: TRefTime): HResult;
  5719. var MP: IMediaPosition;
  5720. begin
  5721.   result := GetPeer(MP);
  5722.   if FAILED(result) then exit;
  5723.   result := MP.get_StopTime(pllTime);
  5724. end;
  5725.  
  5726. function TBCPosPassThru.GetAvailable(out pEarliest,
  5727.   pLatest: int64): HRESULT;
  5728. var MS: IMediaSeeking;
  5729. begin
  5730.   result := GetPeerSeeking(MS);
  5731.   if FAILED(result) then exit;
  5732.   result := MS.GetAvailable(pEarliest, pLatest);
  5733. end;
  5734.  
  5735. function TBCPosPassThru.GetCapabilities(out pCapabilities: DWORD): HRESULT;
  5736. var MS: IMediaSeeking;
  5737. begin
  5738.   result := GetPeerSeeking(MS);
  5739.   if FAILED(result) then exit;
  5740.   result := MS.GetCapabilities(pCapabilities);
  5741. end;
  5742.  
  5743. function TBCPosPassThru.GetCurrentPosition(out pCurrent: int64): HRESULT;
  5744. var
  5745.   MS: IMediaSeeking;
  5746.   Stop: int64;
  5747. begin
  5748.   result := GetMediaTime(pCurrent, Stop);
  5749.   if SUCCEEDED(result) then
  5750.     result := NOERROR
  5751.   else
  5752.     begin
  5753.       result := GetPeerSeeking(MS);
  5754.       if FAILED(result) then exit;
  5755.       result := MS.GetCurrentPosition(pCurrent)
  5756.     end;
  5757. end;
  5758.  
  5759. function TBCPosPassThru.GetDuration(out pDuration: int64): HRESULT;
  5760. var MS: IMediaSeeking;
  5761. begin
  5762.   result := GetPeerSeeking(MS);
  5763.   if FAILED(result) then exit;
  5764.   result := MS.GetDuration(pDuration);
  5765. end;
  5766.  
  5767. function TBCPosPassThru.GetMediaTime(out StartTime,
  5768.   EndTime: Int64): HRESULT;
  5769. begin
  5770.   result := E_FAIL;
  5771. end;
  5772.  
  5773. // Return the IMediaPosition interface from our peer
  5774.  
  5775. function TBCPosPassThru.GetPeer(out MP: IMediaPosition): HRESULT;
  5776. var
  5777.   Connected: IPin;
  5778. begin
  5779.   result := FPin.ConnectedTo(Connected);
  5780.   if FAILED(result) then
  5781.     begin
  5782.       result := E_NOTIMPL;
  5783.       exit;
  5784.     end;
  5785.  
  5786.   result := Connected.QueryInterface(IID_IMediaPosition, MP);
  5787.   Connected := nil;
  5788.   if FAILED(result) then
  5789.     begin
  5790.       result := E_NOTIMPL;
  5791.       exit;
  5792.     end;
  5793.   result := S_OK;
  5794. end;
  5795.  
  5796. function TBCPosPassThru.GetPeerSeeking(out MS: IMediaSeeking): HRESULT;
  5797. var
  5798.   Connected: IPin;
  5799. begin
  5800.   MS := nil;
  5801.  
  5802.   result := FPin.ConnectedTo(Connected);
  5803.   if FAILED(result) then
  5804.     begin
  5805.       result := E_NOTIMPL;
  5806.       exit;
  5807.     end;
  5808.  
  5809.   result := Connected.QueryInterface(IID_IMediaSeeking, MS);
  5810.   Connected := nil;
  5811.   if FAILED(result) then
  5812.     begin
  5813.       result := E_NOTIMPL;
  5814.       exit;
  5815.     end;
  5816.  
  5817.   result := S_OK;
  5818. end;
  5819.  
  5820. function TBCPosPassThru.GetPositions(out pCurrent, pStop: int64): HRESULT;
  5821. var MS: IMediaSeeking;
  5822. begin
  5823.   result := GetPeerSeeking(MS);
  5824.   if FAILED(result) then exit;
  5825.   result := MS.GetPositions(pCurrent, pStop);
  5826. end;
  5827.  
  5828. function TBCPosPassThru.GetPreroll(out pllPreroll: int64): HRESULT;
  5829. var MS: IMediaSeeking;
  5830. begin
  5831.   result := GetPeerSeeking(MS);
  5832.   if FAILED(result) then exit;
  5833.   result := MS.GetPreroll(pllPreroll);
  5834. end;
  5835.  
  5836. function TBCPosPassThru.GetRate(out pdRate: double): HRESULT;
  5837. var MS: IMediaSeeking;
  5838. begin
  5839.   result := GetPeerSeeking(MS);
  5840.   if FAILED(result) then exit;
  5841.   result := MS.GetRate(pdRate);
  5842. end;
  5843.  
  5844. function TBCPosPassThru.GetStopPosition(out pStop: int64): HRESULT;
  5845. var MS: IMediaSeeking;
  5846. begin
  5847.   result := GetPeerSeeking(MS);
  5848.   if FAILED(result) then exit;
  5849.   result := MS.GetStopPosition(pStop);
  5850. end;
  5851.  
  5852. function TBCPosPassThru.GetTimeFormat(out pFormat: TGUID): HRESULT;
  5853. var MS: IMediaSeeking;
  5854. begin
  5855.   result := GetPeerSeeking(MS);
  5856.   if FAILED(result) then exit;
  5857.   result := MS.GetTimeFormat(pFormat);
  5858. end;
  5859.  
  5860. function TBCPosPassThru.IsFormatSupported(const pFormat: TGUID): HRESULT;
  5861. var MS: IMediaSeeking;
  5862. begin
  5863.   result := GetPeerSeeking(MS);
  5864.   if FAILED(result) then exit;
  5865.   result := MS.IsFormatSupported(pFormat);
  5866. end;
  5867.  
  5868. function TBCPosPassThru.IsUsingTimeFormat(const pFormat: TGUID): HRESULT;
  5869. var MS: IMediaSeeking;
  5870. begin
  5871.   result := GetPeerSeeking(MS);
  5872.   if FAILED(result) then exit;
  5873.   result := MS.IsUsingTimeFormat(pFormat);
  5874. end;
  5875.  
  5876. function TBCPosPassThru.put_CurrentPosition(llTime: TRefTime): HResult;
  5877. var MP: IMediaPosition;
  5878. begin
  5879.   result := GetPeer(MP);
  5880.   if FAILED(result) then exit;
  5881.   result := MP.put_CurrentPosition(llTime);
  5882. end;
  5883.  
  5884. function TBCPosPassThru.put_PrerollTime(llTime: TRefTime): HResult;
  5885. var MP: IMediaPosition;
  5886. begin
  5887.   result := GetPeer(MP);
  5888.   if FAILED(result) then exit;
  5889.   result := MP.put_PrerollTime(llTime);
  5890. end;
  5891.  
  5892. function TBCPosPassThru.put_Rate(dRate: double): HResult;
  5893. var MP: IMediaPosition;
  5894. begin
  5895.   if (dRate = 0.0) then
  5896.     begin
  5897.       result := E_INVALIDARG;
  5898.       exit;
  5899.     end;
  5900.  
  5901.   result := GetPeer(MP);
  5902.   if FAILED(result) then exit;
  5903.   result := MP.put_Rate(dRate);
  5904. end;
  5905.  
  5906. function TBCPosPassThru.put_StopTime(llTime: TRefTime): HResult;
  5907. var MP: IMediaPosition;
  5908. begin
  5909.   result := GetPeer(MP);
  5910.   if FAILED(result) then exit;
  5911.   result := MP.put_StopTime(llTime);
  5912. end;
  5913.  
  5914. function TBCPosPassThru.QueryPreferredFormat(out pFormat: TGUID): HRESULT;
  5915. var MS: IMediaSeeking;
  5916. begin
  5917.   result := GetPeerSeeking(MS);
  5918.   if FAILED(result) then exit;
  5919.   result := MS.QueryPreferredFormat(pFormat);
  5920. end;
  5921.  
  5922. function TBCPosPassThru.SetPositions(var pCurrent: int64;
  5923.   dwCurrentFlags: DWORD; var pStop: int64; dwStopFlags: DWORD): HRESULT;
  5924. var MS: IMediaSeeking;
  5925. begin
  5926.   result := GetPeerSeeking(MS);
  5927.   if FAILED(result) then exit;
  5928.   result := MS.SetPositions(pCurrent, dwCurrentFlags, pStop, dwStopFlags);
  5929. end;
  5930.  
  5931. function TBCPosPassThru.SetRate(dRate: double): HRESULT;
  5932. var MS: IMediaSeeking;
  5933. begin
  5934.   if (dRate = 0.0) then
  5935.     begin
  5936.       result := E_INVALIDARG;
  5937.       exit;
  5938.     end;
  5939.   result := GetPeerSeeking(MS);
  5940.   if FAILED(result) then exit;
  5941.   result := MS.SetRate(dRate);
  5942. end;
  5943.  
  5944. function TBCPosPassThru.SetTimeFormat(const pFormat: TGUID): HRESULT;
  5945. var MS: IMediaSeeking;
  5946. begin
  5947.   result := GetPeerSeeking(MS);
  5948.   if FAILED(result) then exit;
  5949.   result := MS.SetTimeFormat(pFormat);
  5950. end;
  5951.  
  5952. { TBCRendererPosPassThru }
  5953.  
  5954. // Media times (eg current frame, field, sample etc) are passed through the
  5955. // filtergraph in media samples. When a renderer gets a sample with media
  5956. // times in it, it will call one of the RegisterMediaTime methods we expose
  5957. // (one takes an IMediaSample, the other takes the media times direct). We
  5958. // store the media times internally and return them in GetCurrentPosition.
  5959.  
  5960. constructor TBCRendererPosPassThru.Create(name: String; Unk: IUnknown;
  5961.   out hr: HRESULT; Pin: IPin);
  5962. begin
  5963.     inherited Create(Name,Unk,hr,Pin);
  5964.     FStartMedia:= 0;
  5965.     FEndMedia  := 0;
  5966.     FReset     := TRUE;
  5967.     FPositionLock := TBCCritSec.Create;
  5968. end;
  5969.  
  5970. destructor TBCRendererPosPassThru.destroy;
  5971. begin
  5972.   FPositionLock.Free;
  5973.   inherited;
  5974. end;
  5975.  
  5976. // Intended to be called by the owing filter during EOS processing so
  5977. // that the media times can be adjusted to the stop time.  This ensures
  5978. // that the GetCurrentPosition will actully get to the stop position.
  5979.  
  5980. function TBCRendererPosPassThru.EOS: HRESULT;
  5981. var Stop: int64;
  5982. begin
  5983.   if FReset then result := E_FAIL
  5984.   else
  5985.     begin
  5986.       result := GetStopPosition(Stop);
  5987.       if SUCCEEDED(result) then
  5988.         begin
  5989.           FPositionLock.Lock;
  5990.           try
  5991.             FStartMedia := Stop;
  5992.             FEndMedia   := Stop;
  5993.           finally
  5994.             FPositionLock.UnLock;
  5995.           end;
  5996.         end;
  5997.     end;
  5998. end;
  5999.  
  6000. function TBCRendererPosPassThru.GetMediaTime(out StartTime,
  6001.   EndTime: int64): HRESULT;
  6002. begin
  6003.   FPositionLock.Lock;
  6004.   try
  6005.     if FReset then
  6006.       begin
  6007.         result := E_FAIL;
  6008.         exit;
  6009.       end;
  6010.     // We don't have to return the end time
  6011.     result := ConvertTimeFormat(StartTime, nil, FStartMedia, @TIME_FORMAT_MEDIA_TIME);
  6012.     if SUCCEEDED(result) then
  6013.       result := ConvertTimeFormat(EndTime, nil, FEndMedia, @TIME_FORMAT_MEDIA_TIME);
  6014.   finally
  6015.     FPositionLock.UnLock;
  6016.   end;
  6017. end;
  6018.  
  6019. // Sets the media times the object should report
  6020.  
  6021. function TBCRendererPosPassThru.RegisterMediaTime(
  6022.   MediaSample: IMediaSample): HRESULT;
  6023. var  StartMedia, EndMedia: TReferenceTime;
  6024. begin
  6025.   ASSERT(assigned(MediaSample));
  6026.   FPositionLock.Lock;
  6027.   try
  6028.     // Get the media times from the sample
  6029.     result := MediaSample.GetTime(StartMedia, EndMedia);
  6030.     if FAILED(result) then
  6031.       begin
  6032.         ASSERT(result = VFW_E_SAMPLE_TIME_NOT_SET);
  6033.         exit;
  6034.       end;
  6035.     FStartMedia := StartMedia;
  6036.     FEndMedia   := EndMedia;
  6037.     FReset      := FALSE;
  6038.     result := NOERROR;
  6039.   finally
  6040.     FPositionLock.Unlock;
  6041.   end;
  6042. end;
  6043.  
  6044. // Sets the media times the object should report
  6045.  
  6046. function TBCRendererPosPassThru.RegisterMediaTime(StartTime,
  6047.   EndTime: int64): HRESULT;
  6048. begin
  6049.   FPositionLock.Lock;
  6050.   try
  6051.     FStartMedia := StartTime;
  6052.     FEndMedia   := EndTime;
  6053.     FReset      := FALSE;
  6054.     result      := NOERROR;
  6055.   finally
  6056.     FPositionLock.UnLock;
  6057.   end;
  6058. end;
  6059.  
  6060. // Resets the media times we hold
  6061.  
  6062. function TBCRendererPosPassThru.ResetMediaTime: HRESULT;
  6063. begin
  6064.   FPositionLock.Lock;
  6065.   try
  6066.     FStartMedia := 0;
  6067.     FEndMedia   := 0;
  6068.     FReset      := TRUE;
  6069.     result      := NOERROR;
  6070.   finally
  6071.     FPositionLock.UnLock;
  6072.   end;
  6073. end;
  6074.  
  6075. { TBCAMEvent }
  6076.  
  6077. function TBCAMEvent.Check: boolean;
  6078. begin
  6079.   result := Wait(0); 
  6080. end;
  6081.  
  6082. constructor TBCAMEvent.Create(ManualReset: boolean);
  6083. begin
  6084.   FEvent := CreateEvent(nil, ManualReset, FALSE, nil);
  6085. end;
  6086.  
  6087. destructor TBCAMEvent.destroy;
  6088. begin
  6089.   if FEvent <> 0 then CloseHandle(FEvent);
  6090.   inherited;
  6091. end;
  6092.  
  6093. procedure TBCAMEvent.Reset;
  6094. begin
  6095.   ResetEvent(FEvent);
  6096. end;
  6097.  
  6098. procedure TBCAMEvent.SetEv;
  6099. begin
  6100.   SetEvent(FEvent);
  6101. end;
  6102.  
  6103. function TBCAMEvent.Wait(Timeout: Cardinal): boolean;
  6104. begin
  6105.   result := (WaitForSingleObject(FEvent, Timeout) = WAIT_OBJECT_0);
  6106. end;
  6107.  
  6108. { TBCRenderedInputPin }
  6109.  
  6110. function TBCRenderedInputPin.Active: HRESULT;
  6111. begin
  6112.   FAtEndOfStream := FALSE;
  6113.   FCompleteNotified := FALSE;
  6114.   result := inherited Active;
  6115. end;
  6116.  
  6117. constructor TBCRenderedInputPin.Create(ObjectName: string;
  6118.   Filter: TBCBaseFilter; Lock: TBCCritSec; out hr: HRESULT;
  6119.   Name: WideString);
  6120. begin
  6121.    inherited Create(ObjectName, Filter, Lock, hr, Name);
  6122.    FAtEndOfStream := FALSE;
  6123.    FCompleteNotified := FALSE;
  6124. end;
  6125.  
  6126. procedure TBCRenderedInputPin.DoCompleteHandling;
  6127. begin
  6128.   ASSERT(FAtEndOfStream);
  6129.   if (not FCompleteNotified) then
  6130.   begin
  6131.     FCompleteNotified := TRUE;
  6132.     FFilter.NotifyEvent(EC_COMPLETE, S_OK, Integer(FFilter));
  6133.   end;
  6134. end;
  6135.  
  6136. function TBCRenderedInputPin.EndFlush: HRESULT;
  6137. begin
  6138.   FLock.Lock;
  6139.   try
  6140.     // Clean up renderer state
  6141.     FAtEndOfStream := FALSE;
  6142.     FCompleteNotified := FALSE;
  6143.     result := inherited EndFlush;
  6144.   finally
  6145.     FLock.UnLock;
  6146.   end;
  6147. end;
  6148.  
  6149. function TBCRenderedInputPin.EndOfStream: HRESULT;
  6150. var
  6151.   fs: TFilterState;
  6152. begin
  6153.   result := CheckStreaming;
  6154.   //  Do EC_COMPLETE handling for rendered pins
  6155.   if ((result = S_OK) and (not FAtEndOfStream)) then
  6156.   begin
  6157.     FAtEndOfStream := TRUE;
  6158.     ASSERT(SUCCEEDED(FFilter.GetState(0, fs)));
  6159.     if (fs = State_Running) then
  6160.       DoCompleteHandling;
  6161.   end;
  6162. end;
  6163.  
  6164. function TBCRenderedInputPin.Run(Start: TReferenceTime): HRESULT;
  6165. begin
  6166.   FCompleteNotified := FALSE;
  6167.   if FAtEndOfStream then DoCompleteHandling;
  6168.   result := S_OK;
  6169. end;
  6170.  
  6171. initialization
  6172. {$IFDEF DEBUG}
  6173.   DebugLog := TStringList.Create;
  6174. {$ENDIF}
  6175.  
  6176. finalization
  6177. begin
  6178.   if TemplatesVar <> nil then TemplatesVar.Free;
  6179.   TemplatesVar := nil;
  6180. {$IFDEF DEBUG}
  6181.   DebugLog.Add(format('FactoryCount: %d, ObjectCount: %d.',[FactoryCount, ObjectCount]));
  6182.   DebugLog.SaveToFile('c:\BaseClass.txt');
  6183.   DebugLog.Free;
  6184. {$ENDIF}
  6185. end;
  6186.  
  6187. end.
  6188.  
  6189.